Forum Discussion

Brass Contributor

Apr 25, 2020

Solved

VBA code to split worksheet by invoice type

I have a sales master data (with over 20 columns). It contains the following: S/N, Customer, Invoice date, Due date, vessel, producer, fiscal regime, quantity, price, sales value, date paid, amo...

Macros and VBA

Zack Barresse
Apr 29, 2020
pbolali I've attached your sample file. It contains two additional sheets. I also Tabled your data on Sheet1. The sheet 'PivotTables' is a PivotTable from the Table as the data source (it's easier to use Tables than standard ranges in my opinion). Then, I dropped the 'REMARKS' field into the Filter area and set it to the first value. Then, I copied the PivotTable two more times (there are only three PivotTables in this example).

PivotTable caveats:
They do not manually refresh. You have to refresh them yourself if data is added to the Table. I tend to add code to the worksheet housing a PivotTable to automatically refresh their data when the worksheet is activated. Also, and more importantly, this example has three PivotTables stacked vertically - this is generally not a good idea. Instead, having a PivotTable on each sheet would negate this issue. The reason is data will want to grow vertically, and two cannot overlap one another. This is also a general rule for Tables as well.

There is another sheet titled 'Subtotal'. This is a copy of the data, although it is not in a Table, because the subtotal feature doesn't work with them. With the data, on the Data ribbon tab, click the Subtotal button. Ensure each change is set for the field 'REMARKS' and you check the columns you want to sum. I've done this to mimic the example you set in Sheet2. It is a fast and easy way to see subtotals by a specific field. These subtotal values will automatically update when you re-apply this feature.

Regarding the VBA code you posted, if either of the above solutions work for you it would negate the need for it. I'm a very big fan of VBA, but if there is a native solution which will work for you, I'll generally recommend using it instead. With that being said, if you still want a VBA solution, I will code one for you.
Automation progress 2020.xlsm1.4 MB

Zack Barresse

Iron Contributor

Apr 27, 2020

You don't need VBA for this. You can either use a PivotTable, or transform as desired with Power Pivot and then produce to a PivotTable. Any VBA solution would be re-creating the wheel and superfluous.

Take a look at these websites for more information regarding PivotTables:
https://www.contextures.com/CreatePivotTable.html
https://exceljet.net/excel-pivot-tables
https://www.myexcelonline.com/category/pivot-tables/

You can have several PivotTables with the same source (PivotCache) and just change your filters accordingly (i.e. copy/paste it many times).

pbolali
Brass Contributor
Apr 27, 2020
I have checked and tried pivot tables..., it did not filter, copy and group the report the way I want.
- Zack Barresse
  Iron Contributor
  Apr 27, 2020
  From what you described, you can get what you want with multiple PivotTables. Without knowing more, we can't really help more. You can either try describing your data in detail, or posting a sample file for us to look at.
  - pbolali
    Brass Contributor
    Apr 28, 2020
    Zack Barresse
    Please find attached a sample with a code I have attempted...
    Sheet1 contains master data, sheet2 contains the filtered data copied from sheet1.
    
    Option Explicit
    Sub Filter_Invoices()
    Dim c As Range, i, z, lr As Long
    Dim lastrow As Long, nextrow As Long
    
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    'Application.ScreenUpdating = False
    
    ' test for entries in the input range - exit sub if no entries
    If WorksheetFunction.CountA(Sheet1.Range("A1:A10")) < 1 Then Exit Sub
    
    'prepare output sheet to receive new filter results
    Sheet2.Cells.Clear
    
    With Sheet1
    
    lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
    
    ' count number of entries in the input cells
    i = WorksheetFunction.CountA(.Range("A1:A9"))
    
    'turn off any previous filters
    If .AutoFilterMode = True Then .AutoFilterMode = False
    
    'loop through input cells and filter and copy results
    For Each c In .Range("A1:A" & i)
    nextrow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row + 3
    .Range("A10:A" & lastrow).AutoFilter field:=1, Criteria1:="=" & c.Value
    .Range("A10:P" & lastrow).SpecialCells(xlCellTypeVisible).Copy Sheet2.Range("A" & nextrow)
    
    With Worksheets("Sheet2")
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    
    '.Cells(lr + 1, 1).Value = "Total"
    'lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Cells(lr + 1, 1).Value = "Total"
    .Cells(lr + 1, 10).Resize(, 8).FormulaR1C1 = "=SUM(R3C:R[-1]C)"
    
    With .Range(.Cells(lr + 1, 1), .Cells(lr + 1, 16))
    .HorizontalAlignment = xlRight
    .Font.Bold = True
    .Interior.Color = rgbLightBlue
    End With
    '.Range("A & lastrow").CurrentRegion.Weight = xlThin
    
    End With
    
    Next c
    
    'turn off filtering
    .AutoFilterMode = False
    End With
    
    Sheet2.Activate
    Sheet2.Range("A4").Select
    
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    'Application.ScreenUpdating = True
    End Sub
    Automation progress 2020.xlsm26 KB