Hello,

I was curious if there is a way in VBA to automatically calculate the sum of a variable # of rows decided by grouping moving from one group to the next? As I stand now I've gotten to the point of adding a blank row after each group and need a total. Here's the section of code my problem pertains to. Please ignore the non-relevant formatting, etc. I'm more then likely still to much of a beginner to know better :

Dim DataArray() ' Array to hold Card and Product Data

Dim CardCol As Long ' Column Number of Card Data
Dim ProdCol As Long ' Column Number of Product Number
Dim StartRow As Long ' Starting Row Number of Data
Dim EndRow As Long ' Last Row Number of Data

Dim J As Long ' Loop Counter
Dim N As Long ' Line Counter

Dim Rng As Range ' Rng is an Range Object Variable
Dim Wks As Worksheet ' Wks is a Worksheet Object Variable


'Turn Off Screen Updating (No Screen Flicker)
Application.ScreenUpdating = False

'Create Short Named Objects
Set Wks = Excel.Worksheets("Sheet1")
Set Rng = Wks.Range("A2:A" & LastRow)

'Set the Array Size
ReDim DataArray(Rng.Count, 12)

'Set the Row and Column Values
StartRow = 2 ' Starting Row of the Data
CardCol = 8 ' Column "A"
ProdCol = 9 ' Column "B"
EndRow = StartRow + Rng.Count - 2

'Copy Worksheet Data into the DataArray
For J = StartRow To EndRow
'Copy Row J, Trans# Data
DataArray(J, 1) = Wks.Cells(J, 1).Value
'Copy Row J, Trans# Data
DataArray(J, 2) = Wks.Cells(J, 2).Value
'Copy Row J, Trans# Data
DataArray(J, 3) = Wks.Cells(J, 3).Value
'Copy Row J, Trans# Data
DataArray(J, 4) = Wks.Cells(J, 4).Value
'Copy Row J, Trans# Data
DataArray(J, 5) = Wks.Cells(J, 5).Value
'Copy Row J, Trans# Data
DataArray(J, 6) = Wks.Cells(J, 6).Value
'Copy Row J, Trans# Data
DataArray(J, 7) = Wks.Cells(J, 7).Value
'Copy Row J, Card Data
DataArray(J, 8) = Wks.Cells(J, CardCol).Value
'Copy Row J, Product Data
DataArray(J, 9) = Wks.Cells(J, ProdCol).Value
'Copy Row J, Trans# Data
DataArray(J, 10) = Wks.Cells(J, 10).Value
'Copy Row J, Trans# Data
DataArray(J, 11) = Wks.Cells(J, 11).Value
'Copy Row J, Trans# Data
DataArray(J, 12) = Wks.Cells(J, 12).Value
Next J

'Re-Write the Data Separated by Blank Lines
For J = 1 To Rng.Count - 1

N = N + 1
With Wks
.Cells(N, 1).Value = DataArray(J, 1)
.Cells(N, 2).Value = DataArray(J, 2)
.Cells(N, 3).Value = DataArray(J, 3)
.Cells(N, 4).Value = DataArray(J, 4)
.Cells(N, 5).Value = DataArray(J, 5)
.Cells(N, 6).Value = DataArray(J, 6)
.Cells(N, 7).Value = DataArray(J, 7)
.Cells(N, CardCol).Value = DataArray(J, 8)
.Cells(N, ProdCol).Value = DataArray(J, 9)
.Cells(N, 10).Value = DataArray(J, 10)
.Cells(N, 11).Value = DataArray(J, 11)
.Cells(N, 12).Value = DataArray(J, 12)
End With

'Test for New Group - Add Blank Line if True
If DataArray(J, 9) = DataArray(J + 1, 9) Then
If DataArray(J, 8) <> DataArray(J + 1, 8) Then
'Increment Line Counter
N = N + 1
'Add Blank Line
With Wks
.Cells(N, 1).Value = ""
.Cells(N, 2).Value = ""
.Cells(N, 3).Value = ""
.Cells(N, 4).Value = ""
.Cells(N, 5).Value = ""
.Cells(N, 6).Value = ""
.Cells(N, 7).Value = ""
.Cells(N, CardCol).Value = DataArray(J, 8)
.Cells(N, ProdCol).Value = ""
.Cells(N, 10).Value = DataArray(J, 10)
.Cells(N, 11).Value = ""
.Cells(N, 12).Value = ""
End With

Range("H" & N, "L" & N).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

End If
ElseIf DataArray(J, 9) <> DataArray(J + 1, 9) Then
'Increment Line Counter
N = N + 1
'Add Blank Line
With Wks
.Cells(N, 1).Value = ""
.Cells(N, 2).Value = ""
.Cells(N, 3).Value = ""
.Cells(N, 4).Value = ""
.Cells(N, 5).Value = ""
.Cells(N, 6).Value = ""
.Cells(N, 7).Value = ""
.Cells(N, CardCol).Value = DataArray(J, 8)
.Cells(N, ProdCol).Value = ""
.Cells(N, 10).Value = DataArray(J, 10)
.Cells(N, 11).Value = ""
.Cells(N, 12).Value = ""
End With

Range("H" & N, "L" & N).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

End If
Next J

'Write Last Line to Worksheet
With Wks
.Cells(N + 1, 1).Value = DataArray(J, 1)
.Cells(N + 1, 2).Value = DataArray(J, 2)
.Cells(N + 1, 3).Value = DataArray(J, 3)
.Cells(N + 1, 4).Value = DataArray(J, 4)
.Cells(N + 1, 5).Value = DataArray(J, 5)
.Cells(N + 1, 6).Value = DataArray(J, 6)
.Cells(N + 1, 7).Value = DataArray(J, 7)
.Cells(N + 1, CardCol).Value = DataArray(J, 8)
.Cells(N + 1, ProdCol).Value = DataArray(J, 9)
.Cells(N + 1, 10).Value = DataArray(J, 10)
.Cells(N + 1, 11).Value = DataArray(J, 11)
.Cells(N + 1, 12).Value = DataArray(J, 12)
End With

'Turn Screen Updating Back On
Application.ScreenUpdating = True


Any help would be fantastic! Thanks.