This will work if you have no header row, as indicated by your data:
Sub InsertTotals()
Dim LastRow As Long
Dim StartRow As Long
Dim EndRow As Long
Application.ScreenUpdating = False
LastRow = Range("A65536").End(xlUp).Row
For i = LastRow To 2 Step -1
If Range("A" & i).Value <> _
Range("A" & i - 1).Value Then
Range("A" & i).EntireRow.Insert
End If
Next
LastRow = Range("A65536").End(xlUp).Row
For i = 1 To LastRow + 1
If Range("A" & i).Value <> "" Then
If StartRow = 0 Then
StartRow = i
End If
Else
EndRow = i - 1
Range("D" & i).Formula = _
"=SUM(C" & StartRow & ":C" & EndRow & ")"
StartRow = 0
End If
Next
Application.ScreenUpdating = True
End Sub
And this will work if you do:
Sub InsertTotals()
Dim LastRow As Long
Dim StartRow As Long
Dim EndRow As Long
Application.ScreenUpdating = False
LastRow = Range("A65536").End(xlUp).Row
For i = LastRow To 3 Step -1
If Range("A" & i).Value <> _
Range("A" & i - 1).Value Then
Range("A" & i).EntireRow.Insert
End If
Next
LastRow = Range("A65536").End(xlUp).Row
For i = 2 To LastRow + 1
If Range("A" & i).Value <> "" Then
If StartRow = 0 Then
StartRow = i
End If
Else
EndRow = i - 1
Range("D" & i).Formula = _
"=SUM(C" & StartRow & ":C" & EndRow & ")"
StartRow = 0
End If
Next
Application.ScreenUpdating = True
End Sub
Regards
Trevor
"andresg1975" <(E-Mail Removed)> wrote in message
news:8F4E6F11-3BE2-4435-9889-(E-Mail Removed)...
> how can i create a macro that goes to column "A", insert a row after a
> date,
> goes to column "C", get a total for that date in column "D" of the same
> row,
> and continue the same procedure.
>
> lets say:
>
> column a b c d
> row 1 09/01/2006 amex 1000
> row 2 09/01/2006 visa 400
> row 3 09/01/2006 visa 800
> 09/02/2006 visa 500
> 09/02/2006 amex 200
>
> result should be:
>
> column a b c d
> row 1 09/01/2006 amex 1000
> row 2 09/01/2006 visa 400
> row 3 09/01/2006 visa 800
> 2200
> 09/02/2006 visa 500
> 09/02/2006 amex 200
> 700
>
> and so on,
>
> thanks a lot
>
|