tr1face
New Member
- Joined
- Jan 7, 2021
- Messages
- 18
- Office Version
- 2016
- 2013
- 2011
- 2010
- 2007
- Platform
- Windows
Hello everyone,
I have the following VBA code which I use to create a detail section for invoices. My problem is that it can only be used for the crt of 1 invoice at the time and I would like to create multiple. Invoice number is located in column A, it would work just great to create another detailed whenever that invoice number changes. Thank you for all your help!
I have the following VBA code which I use to create a detail section for invoices. My problem is that it can only be used for the crt of 1 invoice at the time and I would like to create multiple. Invoice number is located in column A, it would work just great to create another detailed whenever that invoice number changes. Thank you for all your help!
VBA Code:
Sub InvoiceDetails()
Dim last_row As Long ' Number of last row that contains detail data
Dim r As Long ' Row counter
Dim det_cell As Range ' Tracks where data is to be written on the invoice detail sheet
Dim info_cells As Range ' Used to copy PO, MOD, TAG, REF, COST CENTER, CUST DEFINED from template
Dim location_cells As Range ' Used to copy contract#, addr1, addr2, city/st/zip, tax info from template
Dim amount_cells As Range ' Used to copy the amount, tax and total of a transaction from the template
Dim x As Integer
Application.ScreenUpdating = False
Sheets("Template").Select
Sheets("Template").Copy after:=Sheets(2)
Sheets("Template (2)").Select
Sheets("Template (2)").Name = "Copy of Template"
Range("L3").Select
Range(Selection, Selection.End(xlDown)).Select
last_row = Selection.Count + 2
' Add "PO# ", "MOD# ", etc. to front of data on template
Range("J3").Select
For r = 0 To last_row - 3
Range("J3").Offset(r, 0) = Range("J3").Offset(r, 0)
Next r
Range("K3").Select
For r = 0 To last_row - 3
Range("K3").Offset(r, 0) = Range("K3").Offset(r, 0)
Next r
Range("L3").Select
For r = 0 To last_row - 3
Range("L3").Offset(r, 0) = Range("L3").Offset(r, 0)
Next r
Range("M3").Select
For r = 0 To last_row - 3
Range("M3").Offset(r, 0) = Range("M3").Offset(r, 0)
Next r
' Concatenate City, State, Zip on template
Columns("R:R").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("R3").Clear
Range("R3").FormulaR1C1 = "=RC[1]&"", ""&RC[2]&"" ""&RC[3]"
Range("R3").Copy Range("R4:R" & last_row)
Range("R3:R" & last_row).Copy
Range("R3:R" & last_row).PasteSpecial xlPasteValues
Columns("S:U").Delete
' Insert/copy Contract Number column to the left of Shipping Addr1
Columns("P:P").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("P3").Select
ActiveSheet.Paste
' Populate invoice detail
Set det_cell = Sheets("Detail Info").Range("A6")
Set info_cells = Sheets("Copy of Template").Range("J3:O3") ' PO, Mod, Tax info, Ref, Cost Center, User Def of the first charge
Set location_cells = Sheets("Copy of Template").Range("P3:T3") ' Contract#, location, tax info of first charge
Set amount_cells = Sheets("Copy of Template").Range("G3:I3") ' Base, tax, total of first charge
For r = 0 To last_row - 3
info_cells.Copy
det_cell.PasteSpecial Transpose:=True
location_cells.Copy
det_cell.Offset(0, 1).PasteSpecial Transpose:=True
'If charge is rental or renewal, concatenate the charge type and billing period. Otherwise, just copy charge description.
Sheets("Copy of Template").Activate
If Left(Range("D" & r + 3).Value, 3) = "REN" Or _
Left(Range("D" & r + 3).Value, 3) = "Ren" Or _
Left(Range("D" & r + 3).Value, 3) = "ren" Then
det_cell.Offset(0, 2).Value = Range("D" & r + 3).Value & " " & Range("F" & r + 3).Value
Else
det_cell.Offset(0, 2).Value = Range("D" & r + 3).Value
End If
amount_cells.Copy
det_cell.Offset(0, 3).PasteSpecial
Set info_cells = info_cells.Offset(1, 0)
Set location_cells = location_cells.Offset(1, 0)
Set amount_cells = amount_cells.Offset(1, 0)
Set det_cell = det_cell.Offset(7, 0)
Next r
'Formatting
Sheets("Detail Info").Activate
Range(Cells(6, 1), Cells((last_row - 2) * 7 + 7, 6)).Select
Selection.Font.Name = "Museo Sans For Dell"
Selection.Font.Size = 10
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlBottom
Range(Cells(6, 4), Cells((last_row - 2) * 7 + 7, 6)).Select
Selection.NumberFormat = "$#,##0.00"
'Enter invoice totals
Cells((last_row - 2) * 7 + 6, 3).Select
Selection.Value = "Invoice Total"
Selection.Font.bold = True
Cells((last_row - 2) * 7 + 6, 4).Select
Selection.Font.bold = True
Selection.Value = WorksheetFunction.Sum(Range(Cells(6, 4), Cells((last_row - 2) * 7 + 5, 4)))
Cells((last_row - 2) * 7 + 6, 5).Select
Selection.Font.bold = True
Selection.Value = WorksheetFunction.Sum(Range(Cells(6, 5), Cells((last_row - 2) * 7 + 5, 5)))
Cells((last_row - 2) * 7 + 6, 6).Select
Selection.Font.bold = True
Selection.Value = WorksheetFunction.Sum(Range(Cells(6, 6), Cells((last_row - 2) * 7 + 5, 6)))
Application.DisplayAlerts = False
Sheets("Copy of Template").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Sheets("Detail Info").Activate
Range("G6").Select
'Set print area
Worksheets("Detail Info").PageSetup.PrintArea = "$A$1:$F$" & (last_row - 2) * 7 + 7
Dim iX As Double
Dim y As Double
iX = 6
y = 3
Do While Worksheets("Detail Info").Cells(iX, 6) <> ""
Worksheets("Detail Info").Cells(iX, 1) = "PO# " & Worksheets("Template").Cells(y, 10)
Worksheets("Detail Info").Cells(iX + 1, 1) = "MOD# " & Worksheets("Detail Info").Cells(iX + 1, 1)
Worksheets("Detail Info").Cells(iX + 2, 1) = "TAG# " & Worksheets("Detail Info").Cells(iX + 2, 1)
Worksheets("Detail Info").Cells(iX + 3, 1) = "REF# " & Worksheets("Detail Info").Cells(iX + 3, 1)
Worksheets("Detail Info").Cells(iX, 2) = Worksheets("Template").Cells(y, 3)
y = y + 1
iX = iX + 7
Loop
Worksheets("Detail Info").Cells(1, 1) = "Detail Information"
Worksheets("Detail Info").Cells(1, 1).Font.Size = 18
Worksheets("Detail Info").Cells(3, 1) = "Equipment"
Worksheets("Detail Info").Cells(4, 1) = "Information"
Worksheets("Detail Info").Cells(3, 2) = "Equipment"
Worksheets("Detail Info").Cells(4, 2) = "Location"
Worksheets("Detail Info").Cells(3, 3) = "Transaction"
Worksheets("Detail Info").Cells(4, 3) = "Description"
Worksheets("Detail Info").Cells(3, 4) = "TRANSACTION"
Worksheets("Detail Info").Cells(4, 4) = "Amount"
Worksheets("Detail Info").Cells(4, 5) = "Tax"
Worksheets("Detail Info").Cells(4, 6) = "Total"
Worksheets("Detail Info").Range("A1:F2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Worksheets("Detail Info").Range("D3:F3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Worksheets("Detail Info").Range("A1:F4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Selection.Borders
.LineStyle = xlContinuous
.Color = vbBlack
.Weight = xlThin
End With
End Sub