Please Help - Macro to make this process easier

[SARABECK]

Hello,

I need help in making the following task a 1 or 2 step process. Currently, it's very time consuming working with 1500 lines. Below is a sample of my current worksheet.

Screenshot 1 - This is my Data

Screenshot 2: I remove any duplicates to get unique "Account" and "Code" and then complete a SUMIFS formula to get debit and credit dollars from my data tab.

Have the following formula in the Debit Column:
=SUMIFS('Monthly Data'!H:H,'Monthly Data'!H:H,">=0",'Monthly Data'!D:D,Entry!B2,'Monthly Data'!I:I,Entry!E2)

Have the following formula in the Credit Column:
=(SUMIFS('Monthly Data'!H:H,'Monthly Data'!H:H,"<=0",'Monthly Data'!D:D,Entry!B2,'Monthly Data'!I:I,Entry!E2))

I add the Debit Column and Credit Column to the get the net total in column I, Because the system doesn't allow debits and credits on the same line. And, this will be my entry for the month.

Screenshot 3 - Final Entry to submit to the ledger - I manually add to each cell their appropriate debit and credit.

Here is my sample file
sample file1.xlsx

Any help would be appreciated.
thank you.

 

[venkat1926]

I am thinking differently. why not use pivot table. the configuration of the result may not be exactly as you have indicated but the pivot table will give the result.

insert this macro "my_pivot" in the standard module save the file and run this macro and see sheet called "pivotsheet"


I am not highly familiar with the vba for pivot table and so perhaps the macro can be tweaked. but as it is, it seems to work

Sub my_pivot()
    Dim r As Range, c As Range, llastrow As Integer
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    With Worksheets("monthly data")
        Set r = .Range("D1:I17")
    End With
    Sheets.Add
    Worksheets("Pivotsheet").Delete
    ActiveSheet.Name = "pivotsheet"






    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                                      r, Version:=xlPivotTableVersion12).CreatePivotTable _
                                      TableDestination:=Worksheets("Pivotsheet").Range("A3"), TableName:="MyPivotTable", DefaultVersion _
                                                                                                                       :=xlPivotTableVersion12


    With ActiveSheet.PivotTables("MyPivotTable").PivotFields("Account #")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("MyPivotTable").PivotFields("Code")
        .Orientation = xlRowField
        .Position = 2
    End With


    ActiveSheet.PivotTables("MyPivotTable").AddDataField ActiveSheet.PivotTables( _
                                                         "MyPivotTable").PivotFields("Mthly ACCRL"), "Sum of Mthly ACCRL", xlSum




    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Account #").Subtotals = _
    Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Blah").Subtotals = Array( _
                                                                            False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Mthly Estimate").Subtotals _
          = Array(False, False, False, False, False, False, False, False, False, False, False, False _
                                                                                             )
    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Ledger").Subtotals = Array( _
                                                                              False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Mthly ACCRL").Subtotals = _
    Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Code").Subtotals = Array( _
                                                                            False, False, False, False, False, False, False, False, False, False, False, False)
    With ActiveSheet.PivotTables("MyPivotTable")
        .ColumnGrand = False
        .RowGrand = False
    End With
    'Range("C4").Select
    'ActiveCell.FormulaR1C1 = "'debit"
    Range("C3") = "debit"
    Range("d3") = "credit"


    With Worksheets("Pivotsheet")
        llastrow = .Range("a4").End(xlDown).Row
        Set r = .Range(Cells(4, "c"), .Cells(llastrow, "C"))
        For Each c In r
            If Len(.Cells(c.Row, "B")) > 0 And .Cells(c.Row, "B") > 0 Then
                c = Cells(c.Row, "B")
            ElseIf .Cells(c.Row, "B") < 0 Then
                c.Offset(0, 1) = -Cells(c.Row, "B")
            Else
                c = ""
            End If
        Next c
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "pivot table ready see sheet pivotsheet "
End Sub

I took some efforts on this. so I would like to have your comments

 

[venkat1926]

there is a small error in the macro I am giving the corrected macro and also a new macro called "undo_mcro"

for the first time run the macro "my_pivot"
this will create a pivot table sheet .
if you want to recheck you have to remoe this sheet and that is why the second macro . second time you have to first run "undo_mcro" and then run "my_pivot" I am repating the correct macro. discard old macros

Sub my_pivot()
    Dim r As Range, c As Range, llastrow As Integer
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    With Worksheets("monthly data")
        Set r = .Range("D1:I17")
    End With
    Sheets.Add
    
   ' Worksheets("Pivotsheet").Delete
    ActiveSheet.Name = "pivotsheet"


    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                                      r, Version:=xlPivotTableVersion12).CreatePivotTable _
                                      TableDestination:=Worksheets("Pivotsheet").Range("A3"), TableName:="MyPivotTable", DefaultVersion _
                                                                                                                       :=xlPivotTableVersion12


    With ActiveSheet.PivotTables("MyPivotTable").PivotFields("Account #")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("MyPivotTable").PivotFields("Code")
        .Orientation = xlRowField
        .Position = 2
    End With


    ActiveSheet.PivotTables("MyPivotTable").AddDataField ActiveSheet.PivotTables( _
                                                         "MyPivotTable").PivotFields("Mthly ACCRL"), "Sum of Mthly ACCRL", xlSum




    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Account #").Subtotals = _
    Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Blah").Subtotals = Array( _
                                                                            False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Mthly Estimate").Subtotals _
          = Array(False, False, False, False, False, False, False, False, False, False, False, False _
                                                                                             )
    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Ledger").Subtotals = Array( _
                                                                              False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Mthly ACCRL").Subtotals = _
    Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("MyPivotTable").PivotFields("Code").Subtotals = Array( _
                                                                            False, False, False, False, False, False, False, False, False, False, False, False)
    With ActiveSheet.PivotTables("MyPivotTable")
        .ColumnGrand = False
        .RowGrand = False
    End With
    'Range("C4").Select
    'ActiveCell.FormulaR1C1 = "'debit"
    Range("C3") = "debit"
    Range("d3") = "credit"


    With Worksheets("Pivotsheet")
        llastrow = .Range("a4").End(xlDown).Row
        Set r = .Range(Cells(4, "c"), .Cells(llastrow, "C"))
        For Each c In r
            If Len(.Cells(c.Row, "B")) > 0 And .Cells(c.Row, "B") > 0 Then
                c = Cells(c.Row, "B")
            ElseIf .Cells(c.Row, "B") < 0 Then
                c.Offset(0, 1) = -Cells(c.Row, "B")
            Else
                c = ""
            End If
        Next c
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "pivot table ready see sheet pivotsheet "
End Sub

Sub undo_macro()
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("pivotsheet").Delete
Application.DisplayAlerts = True
End Sub

 

[SARABECK]

Thank you so much!!! venkat1926 for your help.

Here is a screenshot after executing the macro. The code works great on my sample data.

As for the original data, how can I modify the Set r = .Range("D1:I17") so that it would pick up everything in Column D and I. I have 1590 lines of data for the current month and it changes on monthly basis (more/less depending on the month).

Also, is there a way to add the account and code too? Like below?

Thanks again for your help. It is very much appreciated.

 

[venkat1926]

I assume there is no blank rows in the data. thenn

set r=range(.range("D1"),.range("I1").end(xldown))
msgbox r.address

the msgbox is to check whether r refers to the data required complexly. if the address is ok you can even remove this msgbox code line only. keep set r=range(......................

 

[SARABECK]

I believe there are 90-150 blank lines.

This works great.

I need to change the heading of some. Can you please tell me in the code below which "Blah" column does this reference to? Column E?

ActiveSheet.PivotTables("MyPivotTable").PivotFields("Blah").Subtotals = Array(

Thank you.

 

[SARABECK]

Got it to work. "Blah" in the code refers to column E.

Awesome!!!!! Thank you.