Update VBA Code for Split and Total

[ravi2628]

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

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

 

[ravi2628]

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
	A	B
1	Employee	Expenditure1
2	Ravi	83076
3	Ravi	72174
4	Ravi	55063
5	Ravi	37073
6	Ravi	49650
7	Ravi	1441
8	Ravi	34368
9	Ravi	38325
10
11	Total	371170
Ravi

Cell Formulas
Range	Formula
B11	B11	=SUM($B$2:$B$9)

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

 

[Alex Blakenburg]

If you add this line:

            wsNames.Cells(lastRowNames + 2, "A") = "Total"

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

 

[ravi2628]

If you add this line:

            wsNames.Cells(lastRowNames + 2, "A") = "Total"

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

Thank you alex

 

[Alex Blakenburg]

No problem.