Forum Discussion
VBA code to split worksheet by invoice type
It contains the following:
S/N, Customer, Invoice date, Due date, vessel, producer, fiscal regime, quantity, price, sales value, date paid, amount paid, variance, remark, etc
1.) I need a macro to group this report by invoice type, sum each group, with the column header and group title for each group on same sheet.
2.) Copy 1 or more groups to form a another report on separate sheets
3.) Write the summary (like a pivot table) for some of the column headers. Eg, Fiscal regime, sum by each producer with columns quantity, sales value and receipts
4.) Group 1 or more of the summaries to form another report on separate sheets.
Not to write too much, I am able to provide more clarity when we start.
Thanks for your kind assistance.
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.
45 Replies
- You can find the button in the picture above, there is a red circle around it.
Click "Developer" tab on the ribbon
Click "Insert Controls" button
Click "Button (Form Control)"
Create a button on sheet
Type a macro name "Button2_Click()"
Click OK
Vba code
Sub Button2_Click()
Dim rng As Range
Dim i As Long
Dim a As Long
Dim rng_dest As Range
Application.ScreenUpdating = False
i = 1
Set rng_dest = Sheets("Invoice data").Range("D:G")
' Find first empty row in columns D:G on sheet Invoice data
Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
i = i + 1
Loop
'Copy range B16:I38 on sheet Invoice to Variant array
Set rng = Sheets("Invoice").Range("B16:E38")
' Copy rows containing values to sheet Invoice data
For a = 1 To rng.Rows.Count
If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
rng_dest.Rows(i).Value = rng.Rows(a).Value
'Copy Invoice number
Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("D13").Value
'Copy Date
Sheets("Invoice data").Range("B" & i).Value = Sheets("Invoice").Range("F3").Value
'Copy Company name
Sheets("Invoice data").Range("C" & i).Value = Sheets("Invoice").Range("B8").Value
i = i + 1
End If
Next a
Application.ScreenUpdating = True
End Sub- Please can you share the workbook. I am not able to relate this code with the workbook I upload earlier
- To copy the secondary data as many times as there are invoice details lines, you could do that as below, just replace your code with this one:
Sub InvoiceToRecords()
Dim ws As Worksheet: Set ws = Worksheets("Invoice")
Dim wsData As Worksheet: Set wsData = Worksheets("Invoice Data")
'declare and set the worksheets, amend as required
Dim i As Long, dataRows As Long
dataRows = ws.Range("Invoice").Columns(1).SpecialCells(xlCellTypeConstants, 23).Count
'count the number of Invoice lines with data (non-empty)
ws.Range("Invoice").Copy wsData.Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
'copy invoice lines to Invoice Data
For i = 1 To dataRows 'loop from 1 to however many lines your named range "Invoice" has
ws.Range("Customer").Copy wsData.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
ws.Range("Invoice Number").Copy wsData.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
ws.Range("Invoice Date").Copy wsData.Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
Next i
End Sub
To save your worksheet as PDF, the following will do, I would use some sort of variable to generate the PDF filename, so you don't keep overwriting the same file, maybe a combination of company & invoice number or even a timestamp would do:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
Filen = "C:\Users\Lorenz\Desktop\NewPdf.pdf"
'amend filename & path to save above
ws.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Filen, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
UPDATE:
Putting it all together now:
Sub InvoiceToRecords()
Dim ws As Worksheet: Set ws = Worksheets("Invoice")
Dim wsData As Worksheet: Set wsData = Worksheets("Invoice Data")
'declare and set the worksheets, amend as required
Dim i As Long, dataRows As Long
'TRANSFER data to Invoice Data
dataRows = ws.Range("Invoice").Columns(1).SpecialCells(xlCellTypeConstants, 23).Count
'count the number of Invoice lines with data (non-empty)
ws.Range("Invoice").Copy wsData.Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
'copy invoice lines to Invoice Data
For i = 1 To dataRows 'loop from 1 to however many lines your named range "Invoice" has
ws.Range("Customer").Copy
wsData.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ws.Range("Invoice Number").Copy
wsData.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ws.Range("Invoice Date").Copy
wsData.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Next i
'SAVE Invoice as PDF
FilenameValue = ws.Range("Customer") & "_Invoice" & ws.Range("Invoice Number")
FilenameValue = Replace(FilenameValue, " ", "") 'remove spaces
FilenameValue = Replace(FilenameValue, ".", "_") 'replace dots with underscore
Filen = "C:\Users\Lorenz\Desktop\" & FilenameValue & ".pdf"
'amend filename & path to save above
ws.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Filen, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'CLEAR ranges ready for next invoice
ws.Range("Invoice").ClearContents
ws.Range("Customer").ClearContents
ws.Range("Invoice Number").ClearContents
ws.Range("Invoice Date").ClearContents
End Sub- I'm not sure Lewis' reply is for this thread. Unless there's some named ranges or other specifications I missed. The code I posted earlier does exactly what you asked.
- If you want to split the data based on column value quickly and automatically, the following VBA code is a good choice. Please do as this:
1. Hold down the ALT + F11 keys to open the Microsoft Visual Basic for Applications window.
2. Click Insert > Module, and paste the following code in the Module Window.- Okay, waiting for the code.
- 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).- I have checked and tried pivot tables..., it did not filter, copy and group the report the way I want.
- 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.
