VBA - sum cells that match criteria and copy rows to different sheet

[justhumm]

I am a complete novice when it comes to VBA (excel 2007) and am looking for some help putting together a macro to help in processing a large number of data rows in a worksheet.

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.

''--------------------------------------------------------------------------------
'' 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

[TABLE="class: grid, width: 1000"]
<tbody>[TR]
[TD]Frame[/TD]
[TD]Station[/TD]
[TD]OutputCase[/TD]
[TD]CaseType[/TD]
[TD]StepType[/TD]
[TD]P[/TD]
[TD]V2[/TD]
[TD]V3[/TD]
[TD]T[/TD]
[TD]M2[/TD]
[TD]M3[/TD]
[TD]FrameElem[/TD]
[TD]ElemStation[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]0.75[/TD]
[TD]DC[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]2.007[/TD]
[TD="align: right"]-11.202[/TD]
[TD="align: right"]1.245[/TD]
[TD="align: right"]-6.739[/TD]
[TD="align: right"]-1.916[/TD]
[TD="align: right"]-4.7053[/TD]
[TD]BNA1-1[/TD]
[TD="align: right"]0.75[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]2.4445[/TD]
[TD]DC[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]2.007[/TD]
[TD="align: right"]-9.804[/TD]
[TD="align: right"]1.245[/TD]
[TD="align: right"]-6.739[/TD]
[TD="align: right"]-4.0256[/TD]
[TD="align: right"]13.0921[/TD]
[TD]BNA1-1[/TD]
[TD="align: right"]2.4445[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]2.4445[/TD]
[TD]DC[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]10.401[/TD]
[TD="align: right"]-6.28[/TD]
[TD="align: right"]0.263[/TD]
[TD="align: right"]-2.7861[/TD]
[TD="align: right"]-1.3307[/TD]
[TD="align: right"]0.7231[/TD]
[TD]BNA1-2[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]3.6667[/TD]
[TD]DC[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]10.401[/TD]
[TD="align: right"]-5.271[/TD]
[TD="align: right"]0.263[/TD]
[TD="align: right"]-2.7861[/TD]
[TD="align: right"]-1.6522[/TD]
[TD="align: right"]7.7821[/TD]
[TD]BNA1-2[/TD]
[TD="align: right"]1.2222[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]4.889[/TD]
[TD]DC[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]10.401[/TD]
[TD="align: right"]-4.263[/TD]
[TD="align: right"]0.263[/TD]
[TD="align: right"]-2.7861[/TD]
[TD="align: right"]-1.9736[/TD]
[TD="align: right"]13.6086[/TD]
[TD]BNA1-2[/TD]
[TD="align: right"]2.4445[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]4.889[/TD]
[TD]DC[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]12.87[/TD]
[TD="align: right"]-0.52[/TD]
[TD="align: right"]-0.199[/TD]
[TD="align: right"]0.1674[/TD]
[TD="align: right"]-0.9366[/TD]
[TD="align: right"]9.9886[/TD]
[TD]BNA1-3[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]6.1112[/TD]
[TD]DC[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]12.87[/TD]
[TD="align: right"]0.489[/TD]
[TD="align: right"]-0.199[/TD]
[TD="align: right"]0.1674[/TD]
[TD="align: right"]-0.6939[/TD]
[TD="align: right"]10.0074[/TD]
[TD]BNA1-3[/TD]
[TD="align: right"]1.2222[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]7.3335[/TD]
[TD]DC[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]12.87[/TD]
[TD="align: right"]1.497[/TD]
[TD="align: right"]-0.199[/TD]
[TD="align: right"]0.1674[/TD]
[TD="align: right"]-0.4512[/TD]
[TD="align: right"]8.7937[/TD]
[TD]BNA1-3[/TD]
[TD="align: right"]2.4445[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]0.75[/TD]
[TD]DW[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]1.279[/TD]
[TD="align: right"]-0.056[/TD]
[TD="align: right"]-0.579[/TD]
[TD="align: right"]0.4405[/TD]
[TD="align: right"]-0.855[/TD]
[TD="align: right"]0.98[/TD]
[TD]BNA1-1[/TD]
[TD="align: right"]0.75[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]2.4445[/TD]
[TD]DW[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]1.279[/TD]
[TD="align: right"]-0.056[/TD]
[TD="align: right"]-0.579[/TD]
[TD="align: right"]0.4405[/TD]
[TD="align: right"]0.1261[/TD]
[TD="align: right"]1.0742[/TD]
[TD]BNA1-1[/TD]
[TD="align: right"]2.4445[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]2.4445[/TD]
[TD]DW[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]1.203[/TD]
[TD="align: right"]0.279[/TD]
[TD="align: right"]-0.326[/TD]
[TD="align: right"]0.6073[/TD]
[TD="align: right"]-0.301[/TD]
[TD="align: right"]1.1812[/TD]
[TD]BNA1-2[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]3.6667[/TD]
[TD]DW[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]1.203[/TD]
[TD="align: right"]0.279[/TD]
[TD="align: right"]-0.326[/TD]
[TD="align: right"]0.6073[/TD]
[TD="align: right"]0.0972[/TD]
[TD="align: right"]0.8402[/TD]
[TD]BNA1-2[/TD]
[TD="align: right"]1.2222[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]4.889[/TD]
[TD]DW[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]1.203[/TD]
[TD="align: right"]0.279[/TD]
[TD="align: right"]-0.326[/TD]
[TD="align: right"]0.6073[/TD]
[TD="align: right"]0.4954[/TD]
[TD="align: right"]0.4992[/TD]
[TD]BNA1-2[/TD]
[TD="align: right"]2.4445[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]4.889[/TD]
[TD]DW[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]0.57[/TD]
[TD="align: right"]0.783[/TD]
[TD="align: right"]-0.144[/TD]
[TD="align: right"]0.4315[/TD]
[TD="align: right"]0.137[/TD]
[TD="align: right"]1.4572[/TD]
[TD]BNA1-3[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]6.1112[/TD]
[TD]DW[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]0.57[/TD]
[TD="align: right"]0.783[/TD]
[TD="align: right"]-0.144[/TD]
[TD="align: right"]0.4315[/TD]
[TD="align: right"]0.3128[/TD]
[TD="align: right"]0.4997[/TD]
[TD]BNA1-3[/TD]
[TD="align: right"]1.2222[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]7.3335[/TD]
[TD]DW[/TD]
[TD]LinStatic[/TD]
[TD][/TD]
[TD="align: right"]0.57[/TD]
[TD="align: right"]0.783[/TD]
[TD="align: right"]-0.144[/TD]
[TD="align: right"]0.4315[/TD]
[TD="align: right"]0.4887[/TD]
[TD="align: right"]-0.4578[/TD]
[TD]BNA1-3[/TD]
[TD="align: right"]2.4445[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]0.75[/TD]
[TD]PHL case[/TD]
[TD]LinMoving[/TD]
[TD]Max P[/TD]
[TD="align: right"]13.04[/TD]
[TD="align: right"]0.669[/TD]
[TD="align: right"]-9.366[/TD]
[TD="align: right"]6.6785[/TD]
[TD="align: right"]-15.7487[/TD]
[TD="align: right"]9.3092[/TD]
[TD]BNA1-1[/TD]
[TD="align: right"]0.75[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]2.4445[/TD]
[TD]PHL case[/TD]
[TD]LinMoving[/TD]
[TD]Max P[/TD]
[TD="align: right"]13.04[/TD]
[TD="align: right"]0.669[/TD]
[TD="align: right"]-9.366[/TD]
[TD="align: right"]6.6785[/TD]
[TD="align: right"]0.1214[/TD]
[TD="align: right"]8.175[/TD]
[TD]BNA1-1[/TD]
[TD="align: right"]2.4445[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]2.4445[/TD]
[TD]PHL case[/TD]
[TD]LinMoving[/TD]
[TD]Max P[/TD]
[TD="align: right"]14.937[/TD]
[TD="align: right"]-2.239[/TD]
[TD="align: right"]-3.737[/TD]
[TD="align: right"]6.5927[/TD]
[TD="align: right"]-5.4166[/TD]
[TD="align: right"]5.1967[/TD]
[TD]BNA1-2[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]3.6667[/TD]
[TD]PHL case[/TD]
[TD]LinMoving[/TD]
[TD]Max P[/TD]
[TD="align: right"]14.937[/TD]
[TD="align: right"]-2.239[/TD]
[TD="align: right"]-3.737[/TD]
[TD="align: right"]6.5927[/TD]
[TD="align: right"]-0.8486[/TD]
[TD="align: right"]7.9331[/TD]
[TD]BNA1-2[/TD]
[TD="align: right"]1.2222[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]4.889[/TD]
[TD]PHL case[/TD]
[TD]LinMoving[/TD]
[TD]Max P[/TD]
[TD="align: right"]14.937[/TD]
[TD="align: right"]-2.239[/TD]
[TD="align: right"]-3.737[/TD]
[TD="align: right"]6.5927[/TD]
[TD="align: right"]3.7193[/TD]
[TD="align: right"]10.6696[/TD]
[TD]BNA1-2[/TD]
[TD="align: right"]2.4445[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]4.889[/TD]
[TD]PHL case[/TD]
[TD]LinMoving[/TD]
[TD]Max P[/TD]
[TD="align: right"]17.793[/TD]
[TD="align: right"]-1.989[/TD]
[TD="align: right"]-2.26[/TD]
[TD="align: right"]5.8633[/TD]
[TD="align: right"]-1.2305[/TD]
[TD="align: right"]6.3499[/TD]
[TD]BNA1-3[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]6.1112[/TD]
[TD]PHL case[/TD]
[TD]LinMoving[/TD]
[TD]Max P[/TD]
[TD="align: right"]17.793[/TD]
[TD="align: right"]-1.989[/TD]
[TD="align: right"]-2.26[/TD]
[TD="align: right"]5.8633[/TD]
[TD="align: right"]1.5311[/TD]
[TD="align: right"]8.7814[/TD]
[TD]BNA1-3[/TD]
[TD="align: right"]1.2222[/TD]
[/TR]
[TR]
[TD]BNA1[/TD]
[TD="align: right"]7.3335[/TD]
[TD]PHL case[/TD]
[TD]LinMoving[/TD]
[TD]Max P[/TD]
[TD="align: right"]17.793[/TD]
[TD="align: right"]-1.989[/TD]
[TD="align: right"]-2.26[/TD]
[TD="align: right"]5.8633[/TD]
[TD="align: right"]4.2928[/TD]
[TD="align: right"]11.213[/TD]
[TD]BNA1-3[/TD]
[TD="align: right"]2.4445[/TD]
[/TR]
</tbody>[/TABLE]

 

[AlphaFrog]

I'm not sure I follow all your description.

I made this Pivot Table from your raw data. The layout may not be the same as you described, but I think the results are.

This sums the LinStatic rows where the two criteria are alike for FrameElem and ElemStation
<br />

Book1
	A	B	C	D	E	F	G	H
1	CaseType	LinStatic
2
3			Data
4	FrameElem	ElemStation	Sum of P	Sum of V2	Sum of V3	Sum of T	Sum of M2	Sum of M3
5	BNA1-1	0.75	3.286	-11.258	0.666	-6.2985	-2.771	-3.7253
6		2.4445	3.286	-9.86	0.666	-6.2985	-3.8995	14.1663
7	BNA1-2	0	11.604	-6.001	-0.063	-2.1788	-1.6317	1.9043
8		1.2222	11.604	-4.992	-0.063	-2.1788	-1.555	8.6223
9		2.4445	11.604	-3.984	-0.063	-2.1788	-1.4782	14.1078
10	BNA1-3	0	13.44	0.263	-0.343	0.5989	-0.7996	11.4458
11		1.2222	13.44	1.272	-0.343	0.5989	-0.3811	10.5071
12		2.4445	13.44	2.28	-0.343	0.5989	0.0375	8.3359
Sheet1

<br />

CaseType is in the Page Area
FrameElem and ElemStation are in the Row Area
The columns you want summed are in the Data Area

Does this work for you?

 

[justhumm]

That generally looks like the information that I'm going for. Though I'll need to look into the pivot table approach (I'm about as familiar with that as I am with VBA)...I actually have my spreadsheet "up and running" using standard excel array functions (which is just painfully slow, right now); and I have a couple of other worksheets set up to do some further processing of the data, so I would need to see how that would work.

And I remember (a while back) someone telling me that pivot tables are a pain to work with when you update your data, but I don't know if that's completely true or not...

Thanks for the feedback!

 

[justhumm]

I kinda had my heart set on getting the VBA up and running, so I fought my way through the code and this seems to be working the way I want it to

''--------------------------------------------------------------------------------
'' PSEUDOCODE FOR MACRO
''--------------------------------------------------------------------------------
'The VBA subroutine filters through a table of data and splits it into 2 arrays
'(originally from SAP2000), based on user-defined criteria contained in one of the columns.
'It then adds together certain cells from matching rows in the two arrays.
'
'Sub Name()
'
'Declare Variables and enter user-defined values
'
'The user  pastes raw data into worksheet1
'clear out a range of cells in worksheet2, where
'
'
'Count the number of data rows that match criteria 1
'Count the number of data rows that match criteria 2
'Redimension each array according to the counted rows
'
'
'Begin loop to split table up into arrays
'For each row in worksheet1,
'   If the value in the criteria column = criteria1,
'   Then
'       Begin a sub-loop to insert each cell in the row into array1
'   Else If the value in the criteria column = criteria2,
'   Then
'       Begin a sub-loop to insert each cell in the row into array2
'Next row, until end of data range in worksheet1...
'
'
'Begin loop add together matching array rows
'For each row in array1,
'   Begin a sub-loop to compare the row in array1 to each row in array2
'   For each row in array2
'       If the the specified column matches for array1 & array2
'       And the specified second column matches for array1 & array2
'       Then
'           Begin a sub-sub-loop to add applicable cells in the row from array 2 into array1
'Next row, until end of array1
'
'
'Set range of cells in worksheet2 = array1
'
'
'End Sub
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------


Option Explicit     'Requires that all variables be defined


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, array2, array3 As Variant
Dim count1, count2, criteria1, criteria2 As String
Dim lastrow, firstrow, lastcol As Integer
Dim ColCrit0, ColComp1, ColComp2 As Integer
Dim i, j, k, m, n, z As Integer
Dim breakcheck1, breakcheck2, breakcheck3 As Variant


criteria1 = "LinMoving"
criteria2 = "LinStatic"
firstrow = 15       ' index number of the first data row in worksheet 1
lastcol = 13        ' index number of the last column row in worksheet 1
ColCrit0 = 4        ' index number of the column that will be compared to criteria
ColComp1 = 12       ' index number of the column that will be compared to in array
ColComp2 = lastcol  ' index number of the column that will be compared to in array


ws2.Activate
ws2.Range(Cells(firstrow, "A"), "M65536").Clear   ' make sure destination cells are empty
ws1.Activate
lastrow = ws1.Cells(65536, 1).End(xlUp).Row ' this counts number of rows that contain data


count1 = Application.WorksheetFunction.CountIf(ws1.Columns(ColCrit0), criteria1)
count2 = Application.WorksheetFunction.CountIf(ws1.Columns(ColCrit0), criteria2)
ReDim array1(1 To count1, 1 To lastcol)
ReDim array2(1 To count2, 1 To lastcol)
ReDim array3(1 To count2, 1 To lastcol)


j = 0   'Initial Row Index in Array1
k = 1   'Initial Column Index in Worksheet1
m = 0
n = 1
For i = firstrow To lastrow
    If ws1.Cells(i, ColCrit0) = criteria1 Then
        j = j + 1
        For k = 1 To lastcol
            array1(j, k) = ws1.Cells(i, k)
        Next k
    ElseIf ws1.Cells(i, ColCrit0) = criteria2 Then
        m = m + 1
        For n = 1 To lastcol
            array2(m, n) = ws1.Cells(i, n)
        Next n
    End If
Next i


For i = 1 To count1
    For j = 1 To count2
        If array1(i, lastcol) = array2(j, lastcol) _
        And array1(i, lastcol - 1) = array2(j, lastcol - 1) _
        Then
        For k = lastcol - 7 To lastcol - 2
            array1(i, k) = array1(i, k) + array2(j, k)
        Next k
        End If
    Next j
Next i


breakcheck1 = array1(1, 7)  'placeholder for checking a value when using "breakpoints" while debugging the VBA
breakcheck2 = array2(10, 3)
breakcheck3 = array3(10, 3)


ws2.Activate
ws2.Range(Cells(firstrow, "A"), Cells(-1 + firstrow + UBound(array1, 1), lastcol)) = array1


Application.ScreenUpdating = True
End Sub