I have a worksheet with raw output data from another program. I want to look through the worksheet, sum certain cells within rows that match criteria (which is based on other cells), and copy those summed rows to another worksheet.
I'm posting the pseudocode (as I see it in my mind) and my first attempt at the VBA code. The first reported bug is in the "k" loop, but I'm sure there are other problems as well.
I hope I have made myself somewhat clear; and if someone could give me some feedback and possible corrections, I would really appreciate it.
Cheers.
I'm posting the pseudocode (as I see it in my mind) and my first attempt at the VBA code. The first reported bug is in the "k" loop, but I'm sure there are other problems as well.
I hope I have made myself somewhat clear; and if someone could give me some feedback and possible corrections, I would really appreciate it.
Cheers.
Code:
''--------------------------------------------------------------------------------
'' PSEUDOCODE FOR MACRO
''--------------------------------------------------------------------------------
''
'Sub Name()
'
'' Declare Variables
''
'worksheet1 = raw source data (60K rows, 13 columns of data)
'worksheet2 = resulting processed data (40k rows, 13 columns of data)
'array1 = temp storage array (40k rows, 13 columns of data)
'array2 = temp starage array (20k rows, 13 columns of data)
'criteria1 = lookup value used to find rows that are placed in array1
'criteria2 = lookup value used to find rows that are placed in array1
'i = index number of the first data row in worksheet 1
'j = index number of the column that will be compared to criteria
'k = index number of the first row in array
'm = index number of the column that will be compared to in array
'n = index number of the column that will be compared to in array
'
'clear out a range of cells in worksheet2
'
'Begin creating temporary arrays
'
'For each row in worksheet1,
' If the value in column "j" = criteria1,
' Then copy that row to array1
'
' Else If the value in column "j" = criteria2,
' Then copy that row to array2
'
' Next row, until end of data range in worksheet1...
'End creation of temporary arrays
'
'Begin adding matching rows in temporary arrays
'
'For each row in array1,
' For each row in array2,
' If array1(column "m") = array2(column "m")
' AND array1(column "n") = array2(column "n")
'
' Then sum array1(columns "m-6" thru "m-1") [where "m-1" is meant as a relative position]
' ...array1(column "m-6") = array1(column "m-6") + array2(column "m-6")
' ...array1(column "m-5") = array1(column "m-5") + array2(column "m-5")
' ...array1(column "m-4") = array1(column "m-4") + array2(column "m-4")
' ...etc.
'
' Next row, until end of data range in array2
' Next row, until end of data range in array1
'End adding matching rows in temporary arrays
'
'Copy & Paste array1 into worksheet2(beginning at row "i", column 1)
'
'End Sub
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' -------------------------
' BADLY CODED VBA FOR MACRO
' -------------------------
Sub matchandadd()
Application.ScreenUpdating = False
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("worksheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("worksheet2")
Dim array1 As Variant
Dim array2 As Variant
Dim criteria1 As String
Dim criteria2 As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
criteria1 = "LinStatic"
criteria2 = "LinMoving"
i = 15 ' index number of the first data row in worksheet 1
j = 4 ' index number of the column that will be compared to criteria
m = 12 ' index number of the column that will be compared to in array
n = 13 ' index number of the column that will be compared to in array
ws2.Range(Cells(i, "A"), "M65536").Clear ' make sure destination cells are empty
For i = i To ws1.Range("M65536").End(xlUp).Row
If ws1.Cells(i, j) = criteria1 _
Then ws1.Rows(i).Copy array1.Rows(array1.Cells(array1.Rows.Count, "A").End(xlUp).Row + 1)
If ws1.Cells(i, j) = criteria2 _
Then ws1.Rows(i).Copy array2.Rows(array2.Cells(array2.Rows.Count, "A").End(xlUp).Row + 1)
Next i
For k = 1 To array1.Rows.Count.End(xlUp).Row
If array1.Cells(k, m) = array2.Cells(k, m) _
And array1.Cells(k, n) = array2.Cells(k, n) _
Then (array1.Range(cells(k, m-6):cells(k, m-1)) = _
array1.Range(cells(k, m-6):cells(k, m-1)) + array2.Range(cells(k, m-6):cells(k, m-1))).Row + 1
Next k
array1.Copy ws2.Rows(i)
Application.ScreenUpdating = True
End Sub
Code:
Frame Station OutputCase CaseType StepType P V2 V3 T M2 M3 FrameElem ElemStation
BNA1 0.75 DC LinStatic 2.007 -11.202 1.245 -6.739 -1.916 -4.7053 BNA1-1 0.75
BNA1 2.4445 DC LinStatic 2.007 -9.804 1.245 -6.739 -4.0256 13.0921 BNA1-1 2.4445
BNA1 2.4445 DC LinStatic 10.401 -6.28 0.263 -2.7861 -1.3307 0.7231 BNA1-2 0
BNA1 3.6667 DC LinStatic 10.401 -5.271 0.263 -2.7861 -1.6522 7.7821 BNA1-2 1.2222
BNA1 4.889 DC LinStatic 10.401 -4.263 0.263 -2.7861 -1.9736 13.6086 BNA1-2 2.4445
BNA1 0.75 HL case LinMoving Max P 13.04 0.669 -9.366 6.6785 -15.74 9.3092 BNA1-1 0.75
BNA1 2.4445 HL case LinMoving Max P 13.04 0.669 -9.366 6.6785 0.1214 8.175 BNA1-1 2.4445
BNA1 2.4445 HL case LinMoving Max P 14.937 -2.239 -3.737 6.5927 -5.4166 5.1967 BNA1-2 0
BNA1 3.6667 HL case LinMoving Max P 14.937 -2.239 -3.737 6.5927 -0.8486 7.9331 BNA1-2 1.2222
BNA1 4.889 HL case LinMoving Max P 14.937 -2.239 -3.737 6.5927 3.7193 10.6696 BNA1-2 2.4445
BNA1 4.889 HL case LinMoving Max P 17.793 -1.989 -2.26 5.8633 -1.2305 6.3499 BNA1-3 0
BNA1 6.1112 HL case LinMoving Max P 17.793 -1.989 -2.26 5.8633 1.5311 8.7814 BNA1-3 1.2222
BNA1 7.3335 HL case LinMoving Max P 17.793 -1.989 -2.26 5.8633 4.2928 11.213 BNA1-3 2.4445