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

Kayslover

Board Regular
Joined
Sep 22, 2020
Messages
159
Office Version
  1. 2013
Platform
  1. Windows
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:-

VBA Code:
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.
 

Attachments

  • Monthly Cash Debits.jpg
    Monthly Cash Debits.jpg
    130.7 KB · Views: 5
  • Amend Monthly Cash Debits.jpg
    Amend Monthly Cash Debits.jpg
    178 KB · Views: 5

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,294
Office Version
  1. 2013
Platform
  1. Windows
@Kayslover Does this help?

VBA Code:
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

Board Regular
Joined
Sep 22, 2020
Messages
159
Office Version
  1. 2013
Platform
  1. Windows
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

Board Regular
Joined
Sep 22, 2020
Messages
159
Office Version
  1. 2013
Platform
  1. Windows
Snakehips,

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

I had to add the following Dim statements

VBA Code:
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).
 

Attachments

  • New Monthly Cash Debits.jpg
    New Monthly Cash Debits.jpg
    90.2 KB · Views: 3

Kayslover

Board Regular
Joined
Sep 22, 2020
Messages
159
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

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.
 

Attachments

  • Amend Monthly Cash Debits(1).jpg
    Amend Monthly Cash Debits(1).jpg
    164.1 KB · Views: 1

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,294
Office Version
  1. 2013
Platform
  1. Windows
By declaring SubTot as Integer you are preventing it from presenting the decimal value.

Declare as....
VBA Code:
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....

VBA Code:
       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

Well-known Member
Joined
Apr 5, 2021
Messages
1,148
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

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

Kayslover

Board Regular
Joined
Sep 22, 2020
Messages
159
Office Version
  1. 2013
Platform
  1. Windows
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. :)(y)
 

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,294
Office Version
  1. 2013
Platform
  1. Windows
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

Board Regular
Joined
Sep 22, 2020
Messages
159
Office Version
  1. 2013
Platform
  1. Windows
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).
 

Forum statistics

Threads
1,137,155
Messages
5,679,921
Members
419,862
Latest member
Bluewings666

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
Top