Macro - Sum/Subtraction - Find a value -

qwertysz

New Member
Joined
Jun 15, 2012
Messages
11
Hi there,

I must say that this Forum was really helpful for me. I found a lot of things there but know I think I need your help. I'm working on Macros but I don't really have so much expirience as much of you. Let me Explain:

Macro:

This was the table
Code
Description
Currency
Debit
Credit
1
AAA
USD
100
2
BBB
USD
200
3
CCC
USD
1500

<TBODY>
</TBODY>


What do I need there? Make the Sum of Column Debit and Credit and put it down. (I managed that, see code below)
The result was:
Code
Description
Currency
Debit
Credit
1
AAA
USD
100
2
BBB
USD
200
3
CCC
USD
1500
1500
300

<TBODY>
</TBODY>

I need something more but I can't manage it..
1 - In E5 (it's a dynamic table), under the 300 he should put the difference between D4 and E4.
2 - Find a value, let a say Code 2, and make the sum of all value (Debit&Credit) founded from Code 2 to the end except the previous totals and put it in E8.

Code:
Sub Macro()
    
    Dim Msg As String
    Msg = MsgBox("Do you want to continue? This Macro was created for TRIAL BALANCE", vbYesNo, "Trial Balance Macro")
     
    Select Case Msg
    
    Case vbYes ' User chose Yes.
         
            Cells.Select
            Cells.EntireColumn.AutoFit
            Range("A1").Select
               
            Dim Rng As Range, r As Range
        
            Set Rng = Range("d8:d" & Range("d" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants)
            For Each r In Rng.Areas
                With r
                .Cells(1, 1).Offset(.Rows.Count).Formula = "=sum(" & .Address & ")"
                End With
            Next
    
            Dim Dng As Range, e As Range
        
            Set Dng = Range("e8:e" & Range("e" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants)
            For Each e In Dng.Areas
                With e
                .Cells(1, 1).Offset(.Rows.Count).Formula = "=sum(" & .Address & ")"
                End With
            Next

            Range("D8:D6000").Select
            Selection.Style = "Comma"
   
            Range("E8:E6000").Select
            Selection.Style = "Comma"
      
    
    Case vbNo ' User chose No.
        
        Exit Sub
        
    End Select
 
End Sub
Hope you can help me out.
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Try this

Code:
Sub Test()

Dim WB As Workbook
Dim WS As Worksheet
Dim LastRow As Long
Dim Msg As String

Set WB = ActiveWorkbook
Set WS = WB.Worksheets(1)

Msg = MsgBox("Do you want to continue? This Macro was created for TRIAL BALANCE", vbYesNo, "Trial Balance Macro")
 
Select Case Msg

Case vbYes ' User chose Yes.
     
    With WS
            .Cells.Select
            .Cells.EntireColumn.AutoFit
            'Only use ColA for LastRow since it will always have data in it.
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("D" & LastRow + 1).Formula = "=sum(D2:" & .Range("D" & LastRow).Address & ")"
            .Range("E" & LastRow + 1).Formula = "=sum(E2:" & .Range("E" & LastRow).Address & ")"
            .Range("E" & LastRow + 2).Formula = "=sum(" & .Range("D" & LastRow).Offset(1, 0).Address _
                 & "-" & .Range("E" & LastRow).Offset(1, 0).Address & ")"
    End With

Case vbNo ' User chose No.
    
    Exit Sub
    
End Select


End Sub
 
Upvote 0
Re: Try this

It seems I haven't the possibility to edit my post...

I have managed to do what I ask for.

Need only one last thing..
- How can I tell the Macro to make a Subtraction between the last value in Column D and the last of Column E and put it under the last value of Column E?

I have tried somethings but doesn't work
 
Upvote 0
Re: Try this

What about the second question? Is it possible?
Yes, but try using Autofilter and see if you can achieve your results.

Need only one last thing..
- How can I tell the Macro to make a Subtraction between the last value in Column D and the last of Column E and put it under the last value of Column E?
It is doing this already.
CodeDescriptionCurrencyDebitCredit
1AAAUSD100
2BBBUSD200
3CCCUSD1500
1500300
1200

<tbody>
</tbody>
The 1200 (E6) has the formula =SUM($D$5-$E$5)
 
Upvote 0
Re: Try this

Yes, but try using Autofilter and see if you can achieve your results.

It is doing this already.
Code
Description
Currency
Debit
Credit
1
AAA
USD
100
2
BBB
USD
200
3
CCC
USD
1500
1500
300
1200

<TBODY>
</TBODY>
The 1200 (E6) has the formula =SUM($D$5-$E$5)

I know, I need that for the 2nd question..

I managed to do all but without Autofilter, it can't help me..
Thanks for your code, it was very helpful
 
Upvote 0
Try this. Question #2

Code:
Sub Test()

Dim WB As Workbook
Dim WS As Worksheet
Dim LastRow As Long
Dim Msg As String
Dim Msg As String
Dim aCell As Range
Dim MyTotal As Double

Set WB = ActiveWorkbook
Set WS = WB.Worksheets(1)

Msg = MsgBox("Do you want to continue? This Macro was created for TRIAL BALANCE", vbYesNo, "Trial Balance Macro")
 
Select Case Msg

Case vbYes ' User chose Yes.
     
    With WS
            .Cells.Select
            .Cells.EntireColumn.AutoFit
            .Cells(1, 1).Select
            'Only use ColA for LastRow since it will always have data in it.
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("D" & LastRow + 1).Formula = "=sum(D2:" & .Range("D" & LastRow).Address & ")"
            .Range("E" & LastRow + 1).Formula = "=sum(E2:" & .Range("E" & LastRow).Address & ")"
            .Range("E" & LastRow + 2).Formula = "=sum(" & .Range("D" & LastRow).Offset(1, 0).Address _
                 & "-" & .Range("E" & LastRow).Offset(1, 0).Address & ")"
    
    Msg = InputBox("Enter Code to search for", "Seach Box")
    If Msg <> "" Then
        For Each aCell In .Range("A2:A" & LastRow)
        If aCell.Value = 2 Then
            MyTotal = MyTotal + aCell.Offset(, 3).Value - aCell.Offset(, 4).Value
        End If
        Next
        .Range("C" & LastRow + 3).Value = "Search Code " & Msg
        .Range("E" & LastRow + 3).Value = MyTotal
    End If
    
    End With

Case vbNo ' User chose No.
    
    Exit Sub
    
End Select


End Sub
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top