Hi,
After you've loaded the data run the following macro
Sub AddTotals()
Dim lFirstRow As Long, lLastRow As Long, lBottomRow As Long, x As Long
Dim dPercent As Double, dSum As Double
Range("A:A").EntireColumn.Insert
lBottomRow = Range("B" & Rows.Count).End(xlUp).Row
Range("A2") = "=IF(AND(B3="""",B2<>B3),""Bot""&ROW(),IF(LEFT(B1,4)=""Item"",""Top""&ROW(),""""))"
Range("A2").Copy Destination:=Range("A3:A" & lBottomRow)
For x = 1 To lBottomRow
If Left(Range("A2").Cells(x, 1), 3) = "Top" Then lFirstRow = Right(Range("A2").Cells(x, 1), Len(Range("A2").Cells(x, 1)) - 3)
If Left(Range("A2").Cells(x, 1), 3) = "Bot" Then
lLastRow = Right(Range("A2").Cells(x, 1), Len(Range("A2").Cells(x, 1)) - 3)
dSum = WorksheetFunction.Sum(Range("I" & lFirstRow & ":I" & lLastRow))
Range("I" & lLastRow + 1) = dSum
Range("I" & lLastRow + 2) = dSum * 0.04
Range("F" & lLastRow + 2) = "4%"
Range("I" & lLastRow + 3) = dSum + dSum * 0.04
Range("I" & lLastRow + 1).Borders(xlEdgeTop).LineStyle = xlContinuous
Range("I" & lLastRow + 3).Borders(xlEdgeTop).LineStyle = xlContinuous
Range("I" & lLastRow + 3).Borders(xlEdgeBottom).LineStyle = xlDouble
End If
dSum = 0
Next x
Range("A:A").EntireColumn.Delete
End Sub
Bookmarks