Forum Discussion
VBA code to split worksheet by invoice type
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.
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.
Thank you so much @ Zack_Barresse. Do you mind to share the workbook with this working code please.
