Define range/ lastrow in VBA

Question

I am trying to export data from excelsheet to excel Invoice template. The VBA code which I have, It considers each row as a different Invoice and hence makes a different workbook for each row. In case I have 1 invoice with 3 products in 3 rows this code considers each of the product (row) as separate Invoice which is not correct. I want to modify it in a way that if the Invoice number (PiNo) is repeated in the next row then it means the next product (row) belongs to the above Invoice only. I am new to VBA hence I have taken code from another site.

Here is the code:-

   Private Sub CommandButton1_Click()
   Dim r As Long
   Dim path As String
   Dim myfilename As String
   lastrow = Sheets(“CustomerDetails”).Range(“H” & Rows.Count).End(xlUp).Row
   r = 2
   For r = 2 To lastrow

   ClientName = Sheets("CustomerDetails").Cells(r, 6).Value
   Address = Sheets("CustomerDetails").Cells(r, 13).Value
   PiNo = Sheets("CustomerDetails").Cells(r, 5).Value
   Qty = Sheets("CustomerDetails").Cells(r, 9).Value
   Description = Sheets("CustomerDetails").Cells(r, 12).Value
   UnitPrice = Sheets("CustomerDetails").Cells(r, 10).Value
   Salesperson = Sheets("CustomerDetails").Cells(r, 1).Value
   PoNo = Sheets("CustomerDetails").Cells(r, 3).Value
   PiDate = Sheets("CustomerDetails").Cells(r, 4).Value
   Paymentterms = Sheets("CustomerDetails").Cells(r, 7).Value
   PartNo = Sheets("CustomerDetails").Cells(r, 8).Value
   Shipdate = Sheets("CustomerDetails").Cells(r, 14).Value
   Dispatchthrough = Sheets("CustomerDetails").Cells(r, 15).Value
   Modeofpayment = Sheets("CustomerDetails").Cells(r, 16).Value
   VAT = Sheets("CustomerDetails").Cells(r, 17).Value

   Workbooks.Open ("C:\Users\admin\Desktop\InvoiceTemplate.xlsx")
   ActiveWorkbook.Sheets("InvoiceTemplate").Activate
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“Z8”).Value = PiDate
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AG8”).Value = PiNo
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AN8”).Value = PoNo
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B16”).Value = ClientName
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B17”).Value = Address
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B21”).Value = Shipdate
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“K21”).Value = Paymentterms
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“T21”).Value = Salesperson
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AC21”).Value = Dispatchthrough
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AL21”).Value = Modeofpayment
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B25”).Value = PartNo
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“J25”).Value = Description
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“Y25”).Value = Qty
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AF25”).Value = UnitPrice
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AL39”).Value = VAT

   path = "C:\Users\admin\Desktop\Invoices\"
   ActiveWorkbook.SaveAs Filename:=path & PiNo & “.xlsx”
   myfilename = ActiveWorkbook.FullName
   ActiveWorkbook.Close SaveChanges:=True

   Next r

   End Sub

"H" is the Product column and the data starts from Row 2. Row 1 are headers.

Any kind of help is appreciated!

enter image description here

Answer 1

Your code is lacking declarations. In view of the multitude of variables your design needs I figured the best way would be to declare Types . That are user defined structured variables, basically arrays with named elements. Since you now want to write the headers and bodies of invoices in separate operations (many body items for each one header) you need different Types for invoice body and invoice items.

Type Invoice
    ClientName As String
    Address As String
    PiNo As String
    PiDate As Date
    Salesperson As String
    PoNo As String
    VAT As Double
    PaymentTerms As String
    PaymentMode As String
    ShipDate As Date
    DispatchThrough As String
End Type

Type Item
    Qty As Double
    PartNo As String
    Description As String
    UnitPrice As Double
End Type

Private Sub CommandButton1_Click()

    Const InvoiceItemRow As Long = 25       ' modify to suit

    Dim WbInv As Workbook
    Dim Path As String
    Dim InvFileName As String
    Dim WsInv As Worksheet
    Dim WsCust As Worksheet                 ' always name your sheet
    Dim PiNo As String, Pi As String
    Dim Inv As Invoice, Itm As Item
    Dim Pos As Integer                      ' invoice item counter (1st item = 0)
    Dim NewInvoice As Boolean
    Dim LastRow As Long
    Dim R As Long

    Path = "C:\Users\admin\Desktop\Invoices\"
    ' you may like to use this syntax instead
    Path = Environ("UserProfile") & "\Desktop\Invoices\"

    ' Spaces are permitted in tab names. You may use "Customer Details"
    Set WsCust = ThisWorkbook.Worksheets("CustomerDetails")
    ' observe the leading period in .Rows.Count. That's why to use the With statement.
    With WsCust
        ' Use the Range object to define a range
        LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
        ' but use the Cells collection to define a cell.
        LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
        ' delete the line you don't want to keep
    End With

    Application.ScreenUpdating = False          ' avoid flicker
    For R = 2 To LastRow
        Pi = WsCust.Cells(R, 5).Value
        If PiNo <> Pi Then
            NewInvoice = True
            If Not WbInv Is Nothing Then
                ' if there is a started invoice already, close it
               InvFileName = Path & Inv.PiNo & ".xlsx"
               With WbInv
                .SaveAs Filename:=InvFileName, FileFormat:=xlOpenXMLWorkbook
                .Close SaveChanges:=True
               End With
            End If
            Inv = SetInvoice(R, WsCust)
        End If

        Itm = SetItem(R, WsCust)
        If NewInvoice Then
            ' if it's a template, save it with xltx or xltm extension
            ' and, in any case, create a copy with the Add Method
            Set WbInv = Workbooks.Add("C:\Users\admin\Desktop\InvoiceTemplate.xlsx")
            Set WsInv = WbInv.Worksheets("InvoiceTemplate")

            With WsInv
                .Cells(16, "B").Value = .ClientName
                .Cells(17, "B").Value = Inv.Address
                .Cells(8, "AG").Value = Inv.PiNo
                .Cells(8, "Z").Value = Inv.PiDate
                .Cells(21, "T").Value = Inv.Salesperson
                .Cells(8, "AN").Value = Inv.PoNo
                .Cells(39, "AL").Value = Inv.VAT
                .Cells(21, "K").Value = Inv.PaymentTerms
                .Cells(21, "AL").Value = Inv.PaymentMode
                .Cells(21, "B").Value = Inv.ShipDate
                .Cells(21, "AC").Value = Inv.DispatchThrough
            End With
            Pos = 0                             ' reset item counter
            NewInvoice = False
        Else
            Pos = Pos + 1
        End If

        With WsInv.Rows(InvoiceItemRow + Pos)
            ' find out the column number with Debug.Print ? Columns("AF").Column
            .Cells(2).Value = PartNo
            .Cells(10).Value = Description
            .Cells(25).Value = Qty
            .Cells(32).Value = UnitPrice
        End With
        PiNo = Pi
    Next R
    Application.ScreenUpdating = True
End Sub

Private Function SetInvoice(ByVal R As Long, _
                            Ws As Worksheet) As Invoice

    Dim Fun As Invoice

    With Fun
        .ClientName = Ws.Cells(R, 6).Value
        .Address = Ws.Cells(R, 13).Value
        .PiNo = Ws.Cells(R, 5).Value
        .PiDate = Ws.Cells(R, 4).Value
        .Salesperson = Ws.Cells(R, 1).Value
        .PoNo = Ws.Cells(R, 3).Value
        .VAT = Ws.Cells(R, 17).Value
        .PaymentTerms = Ws.Cells(R, 7).Value
        .PaymentMode = Ws.Cells(R, 16).Value
        .DispatchThrough = Ws.Cells(R, 15).Value
        .ShipDate = Ws.Cells(R, 14).Value
    End With
End Function

Private Function SetItem(ByVal R As Long, _
                         Ws As Worksheet) As Item

    Dim Fun As Item

    With Fun
        .Qty = Ws.Cells(R, 9).Value
        .PartNo = Ws.Cells(R, 8).Value
        .Description = Ws.Cells(R, 12).Value
        .UnitPrice = Ws.Cells(R, 10).Value
    End With

    SetItem = Fun
End Function

I have tested this code perfunctorily except for the Save & Close part. If your more thorough testing uncovers errors please bear with me, let me know, and I shall correct them.

Testing the SaveAs procedure ============== (Edit Apr 7, 2020)

The procedure below is an extract from the above. It uses the same syntax for SaveAs as the above code. Follow these steps.

1. Create a new workbook from your InvoiceTemplate. Its name should be InvoiceTemplate1 and never saved before. Make it the ActiveWorkbook.
2. Modify the procedure to create the InvFilename variable in exactly the same way as your code does.

3. Then run the procedure.

   Private Sub TestSaveAs()

    Dim WbInv As Workbook Dim InvFilename As String Set WbInv = ActiveWorkbook InvFilename = Environ("UserProfile") & "\Desktop\MyWorkbook.xlsx" With WbInv.SaveAs Filename:=InvFilename, FileFormat:=xlOpenXMLWorkbook.Close SaveChanges:=True End With

   End Sub