Insert Rows & Total

[room7]

My Data:
[Date ] [Name & Exp ] [amount]
[1/1/11] [John Doe Fedex] [5.00]
[1/5/11] [John Doe Stapes] [60.00]
[1/6/11] [Adam Smith Rental] [250.00]
[1/8/11] [Adam Smith Hotel] [299.00]

Task: Need a macro to
1)insert a line inbetween the change in name
2)insert a (-sum) of the amounts for that person
3)insert the person's name

Ideal Outcome:
[Date ] [Name & Exp ] [amount]
[1/1/11] [John Doe Fedex] [5.00]
[1/5/11] [John Doe Stapes] [60.00]
[John Doe] [-65.00]
[1/6/11] [Adam Smith Rental] [250.00]
[1/8/11] [Adam Smith Hotel] [299.00]
[Adam Smith] [-549.00]

 

[room7]

for 3) I have this and it works well

=TRIM(LEFT(SUBSTITUTE(A1," ",REPT(" ",100)),200))

but i still have to go insert a line and paste the equation manually

I tired putting it into a macro with a ctr+up function, but its not working for me

 

[room7]

Please help. A macro would save me about 10 hours a week. I just cant get it to work right
What I do:
1) Go through and mannually instert line between each new name
- move down list, shift+space, ctr+(+)
2) Add sums move from bottom up
- alt+h,u,s, enter
-ctr+up, up
-repeat over and over and over
3) Go though the list and add negative signs to all the sum equations

 

[John Davis]

Please help. A macro would save me about 10 hours a week. I just cant get it to work right
What I do:
1) Go through and mannually instert line between each new name
- move down list, shift+space, ctr+(+)
2) Add sums move from bottom up
- alt+h,u,s, enter
-ctr+up, up
-repeat over and over and over
3) Go though the list and add negative signs to all the sum equations

If your data layout is like this then using Sheet2 as a helper this macro might work.

Date............Name.............Exp......... amount
01/01/2011...John Doe........ Fedex...... $5.00
01/05/2011...John Doe........ Stapes.....$60.00
01/06/2011...Adam Smith.... Rental.....,$250.00
01/08/2011...Adam Smith.... Hotel.......$299.00

Sub room7()
'
Dim i As Long

Dim lr As Long
'
'
With Range("A1:D100")
        .Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(4), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        .Copy Sheets("Sheet2").Range("A2")
        .RemoveSubtotal
End With

Sheets("Sheet2").Activate

On Error Resume Next

Columns("B:B").Select

        Selection.Find(What:="Grand Total", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
ActiveCell.EntireRow.Delete

lr = Cells(Rows.Count, 4).End(3).Row

    For i = lr To 2 Step -1
    
        If Range("C" & i) = "" Then
        Range("E" & i) = -Range("D" & i).Value
        Range("D" & i).Value = Range("E" & i).Value
        End If
        
    Next i
    
Columns("E:E").Delete Shift:=xlToLeft
    
Cells.Copy Sheets("Sheet1").Cells

Cells.Clear


End Sub