Help with sorting and inserting a Total Line on change of category in a cell using a macro.

[Kayslover]

Hi All,

Apologies, before I start as this question may seem convoluted.

Background

I have a macro called Z_Consolidate_Monthly_Expenses which basically does the following:-

• Creates headers for columns, formats them;
• Extracts Expenses sheets from 5 worksheets;
• Saves the sheet as Monthly Cash Debits
• Copies Monthly Cash Debits and renames it to Monthly Non Cash Debits
• Calls a macro called G_Format_Monthly_Cash_Debits
  This macro Applies a Filter to find NON BLANKS in Column D (i.e AutoFilter Field:=4) and then using the LastRow deletes data that is not required and finally sets the Print range.
  On return to Z_Consolidate_Monthly_Expenses, it calls a macro called H_Format_Monthly_Non_Cash_Debits and does basically the same as G_Format_Monthly_Cash_Debits but the Filter look for BLANKS in Column D (i.e AutoFilter Field:=4
  On return to Z_Consolidate_Monthly_Expenses, it protects sheets and ends the process.

Required

What I would like to happen for sheet called Monthly Cash Debits is to have it sorted from Row 4 Columns A to H (Columns E to G are hidden) to the last row that has data in it.

Rows 1 to 3 are headings and E3 is a Total of all the items on the Sheet.

I created a macro to sort and it came up with:-

Range("A4:H" & LastRow).Select
ActiveWorkbook.Worksheets("Monthly Cash Debits").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Monthly Cash Debits").Sort.SortFields.Add Key:= _
Range("H4:H" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Monthly Cash Debits").Sort.SortFields.Add Key:= _
Range("D4:D" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Monthly Cash Debits").Sort
.SetRange Range("A4:H" & LastRow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
 End With

Please note that I have inserted the reference to & LastRow as the existing macro determines the lastrow. Please note the Sheet has set Filters set on in all columns.

Once sorted, on change of data in Column H, I would like to have a Totals Line inserted in a new row with the Cell in Column A set to “Totals for Category nnnn“ where nnnn is the description from column H and the totals of all items that belong to the first Cost Classification in the same row in column E.

The above process of inserting a Totals Line should continue until there are no more.

The new total rows should be formatted as font Candara, 14, Bolded and in RED.

I attach and example of what the sheets looks like at the moment (called Monthly Cash Debits) and what I would like it to look like once the macro has been amended to achieve the above (called Amend Monthly Cash Debits). Please note I have added Column name in both example to aid people looking at this.

I have not include the macros mention above in this post, however if anyone needs to see them please let me know and I will post them.

I hope that the above makes sense.

I will be grateful for any assistance offered.

 

[Snakehips]

@Kayslover Does this help?

Sub SubTots()
LastRow = 14  '******
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets("Monthly Cash Debits")
    With .Sort
        .SortFields.Clear
        .SortFields.Add Key:= _
        Range("H4:H" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
        .SortFields.Add Key:= _
        Range("D4:D" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
        
        .SetRange Range("A4:I" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
     End With
 Class1 = .Cells(4, 8)  ' H4**
  r = 4
 
 Do Until r > LastRow + i + 1
 Classr = .Cells(r, 8)
 If Classr = Class1 Then
 SubTot = SubTot + .Cells(r, 5)
 Else
 'insert a row etc.
 .Cells(r, 8).EntireRow.Insert
         With .Range(.Cells(r, 1), .Cells(r, 5)).Font
            .Name = "Candara"
            .Size = 14
            .Bold = True
            .Color = -16777024
        End With
 .Cells(r, 1) = "Totals for Category " & Class1
 .Cells(r, 5) = SubTot
 SubTot = 0
 Class1 = Classr
 i = i + 1
 End If
 
 r = r + 1
 Loop

End With

Application.ScreenUpdating = True
End Sub

 

[Kayslover]

Snakehips,

Firstly thank you for taking time to assist.

I am away from my PC for the rest of the day and therefore cannot try out your recommendation until tomorrow.

I will try it out and let you know the outcome.

Thank you once again.

 

[Kayslover]

Snakehips,

I have tried out your recommendations and it works 99%. The following are my observations:-

I had to add the following Dim statements

Dim Class1 As String
Dim Classr As String
Dim SubTot As Integer
Dim r As Integer
Dim i As Integer

I initially added Class1 and Classr As Integers, but got a Runtime error and therefore changed them to String and the runtime error disappeared.

The totalling for the last item seems to be rounded up (see new image NEW Monthly Cash Debits)

The value should be £5.58, but it is showing a value of £6.00

Is it possible to have the Totals for Category heading Left Aligned to the Column A?

I have a sheet called Monthly Non Cash Debits which starts off as a copy of Monthly Cash Debits, where I have inserted the code as well, but have some issues.

I will mention once the above totalling problem has been resolved (Hope you don’t mind).

 

[Kayslover]

Snakerhips,

I attach another image which shows further totals that seem to be rounding having added some more expenses.

The last 5 columns show what the totals should be.

FYI, the value in E3 is the overall total when the sheet is first created.

 

[Snakehips]

By declaring SubTot as Integer you are preventing it from presenting the decimal value.

Declare as....

Dim SubTot As Double

For the left justify of text in A and to ensure SubTot displays to two decimal places make the following edit....

       End With
        
 .Cells(r, 1).HorizontalAlignment = xlLeft   '<<<<<<<
 .Cells(r, 1) = "Totals for Category " & Class1
 .Cells(r, 5).NumberFormat = "0.00"  '<<<<<<<
 .Cells(r, 5) = SubTot
 SubTot = 0

 

[Marc L]

Hi,​

​

when accuracy is a concern the better is to use Currency data type rather than Double …​

 

[Kayslover]

Snakehips,

Made the change to the Dim statement and the code you have supplied and both work as expected.

I said in my post #4 that I have another sheet called Monthly Non Cash Debits that is created by copying sheet Monthly Cash Debits before you fantastic code is run.

I was having issues with the results having inserted you code in there with the Totals for Category line as I wanted it to total two fields. I have since reviewed your code and made slight changes to change the column reference and that too works like a charm. Should you want to see the amended code then please let me know.

I am grateful for the time you have spent in helping me.

 

[Snakehips]

You are most welcome! I'm glad it is working for you and that you gained sufficient insight to tweak the code to deal with your second sheet.

 

[Kayslover]

Mark L,

Thank you for you input, as it is a currency field, I have used your recommendation (Hope Snakehips doesn't take offence to it).