Update VBA Code for Split and Total

ravi2628

Board Regular
Joined
Dec 20, 2017
Messages
209
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi Friends,

good morning/afternoon/eveing/night.

I have the following code to split the data into multiple sheets but I want to add a total in the last row.

can anyone please help to add the additional line of code to work?.

But total column may not be fixed every time so I need to specify the column/columns
VBA Code:
Option Explicit
Sub FilterFixedColumn()
    Dim wsData As Worksheet, wsNames As Worksheet, wsFilter As Worksheet
    Dim Datarng As Range, FilterRange As Range
    Dim rowcount As Long
    Dim FilterCol As Variant, FilterValue As Variant
    Dim SheetName As String
   
    On Error GoTo progend
'your master sheet
    Set wsData = ThisWorkbook.Worksheets("Sheet1")
   
'Column you are filtering
    FilterCol = "A"
   
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With
'add filter sheet
    Set wsFilter = ThisWorkbook.Worksheets.Add
   
    With wsData
        .Activate
'add password if needed
        .Unprotect Password:=""
       
        Set Datarng = .Range("A1").CurrentRegion
       
'extract values from FilterCol'to filter sheet
        .Cells(1, FilterCol).Resize(Datarng.Rows.Count).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=wsFilter.Range("A1"), Unique:=True
       
        rowcount = wsFilter.Cells(wsFilter.Rows.Count, "A").End(xlUp).Row
'set Criteria
        wsFilter.Range("B1").Value = wsFilter.Range("A1").Value
       
        For Each FilterRange In wsFilter.Range("A2:A" & rowcount)
'check for blank cell in range
            If Len(FilterRange.Value) > 0 Then
             FilterValue = FilterRange.Value
'USA date format required for filter
             If IsDate(FilterValue) Then FilterValue = Format(FilterValue, "mm/dd/yyyy")

'exact matches only
                wsFilter.Range("B2").Formula = "=" & """=" & FilterValue & """"
               
'date selection - replace illegal "/" character
                SheetName = Replace(FilterValue, "/", "-")
               
'ensure tab name limit not exceeded
                SheetName = Trim(Left(SheetName, 31))
               
'check if sheet exists
                If Not Evaluate("ISREF('" & SheetName & "'!A1)") Then
'add new sheet
                    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName
                End If
'set object variable to sheet
                Set wsNames = Worksheets(SheetName)
'clear sheet
                wsNames.UsedRange.Clear
'copy data
                Datarng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsFilter.Range("B1:B2"), _
                CopyToRange:=wsNames.Range("A1"), Unique:=False
            End If
'autofit columns
            wsNames.UsedRange.Columns.AutoFit
'clear from memory
            Set wsNames = Nothing
        Next
        .Select
    End With
progend:
    wsFilter.Delete
    With Application
        .ScreenUpdating = True: .DisplayAlerts = True
    End With
    If Err <> 0 Then
        MsgBox (Error(Err)), vbCritical, "Error"
        Err.Clear
    End If
End Sub




Thanks In advance

Regards,
Ravi
 
Last edited by a moderator:

ravi2628

Board Regular
Joined
Dec 20, 2017
Messages
209
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I don't know what that means.

Did you get an input box ?
What did you put in the input box ?
Did you get totals in any of the column on the output sheet ?

If there is not much data in your output can you do an XL2BB or picture of your output.
If there is a lot of data can you show me the Top of the sheet with Column and Row references and also the bottom with Column and Row references.
Hi Alex,

I was asking for a grand total or total title at bottom of the row.

Split With Total (002).xlsb
AB
1EmployeeExpenditure1
2Ravi83076
3Ravi72174
4Ravi55063
5Ravi37073
6Ravi49650
7Ravi1441
8Ravi34368
9Ravi38325
10
11Total371170
Ravi
Cell Formulas
RangeFormula
B11B11=SUM($B$2:$B$9)



Like A11 I need the title of the for the Row.
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
2,304
Office Version
  1. 365
Platform
  1. Windows
If you add this line:
VBA Code:
            wsNames.Cells(lastRowNames + 2, "A") = "Total"

After the line "Next rCol", do you get what you need ?
 

Forum statistics

Threads
1,148,422
Messages
5,746,589
Members
424,032
Latest member
pochie2741

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