Error on VBA code to transfer data from sheet to invoice template

[Clairexcel]

Hello again everyone, I have been working on a code for a while now.
I have two sheetts, the first one is Takings and I want to vba code to transfer data from Takings sheet to Invoice sheet, based on customer's name.
Now given that there may be multiple rows containing the same customer name, so I would like that if I enter a customer in the input message box, the code to open as many pdfs as rows related to that customer. It was working this way unill last week then something changed...
My second problem is that it now opens me a PDF after entering customer name, but after that the code gives me an error "Error run time 2147018887 document not saved and it highlights me one of the last rows, the one I underlined...
I hereby attach my code, any help is much appreciated, thank you

Sub getDataSheet1()

Dim erow As Long
 Dim ws1 As Worksheet, ws2 As Worksheet
 Set ws1 = Worksheets("Takings")
 Set ws2 = Worksheets("Invoice")
 erow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
 Dim tenantno As String
 cliente = InputBox("Inserisci nome cliente")
 For i = 4 To erow
 If ws1.Cells(i, 1) = cliente Then
ws2.Range("F2") = ws1.Cells(i, 1)

ws2.Range("A7") = ws1.Cells(i, 4)
ws2.Range("A10") = ws1.Cells(i, 7)
ws2.Range("E12") = ws1.Cells(i, 23)
ws2.Range("E13") = ws1.Cells(i, 24)
ws2.Range("E14") = ws1.Cells(i, 25)
ws2.Range("E15") = ws1.Cells(i, 26)
ws2.Range("E16") = ws1.Cells(i, 27)
ws2.Range("E17") = ws1.Cells(i, 28)
ws2.Range("F12") = ws1.Cells(i, 30)
ws2.Range("F13") = ws1.Cells(i, 31)
ws2.Range("F14") = ws1.Cells(i, 32)
ws2.Range("F15") = ws1.Cells(i, 33)
ws2.Range("F16") = ws1.Cells(i, 34)
ws2.Range("F17") = ws1.Cells(i, 35)

ws2.Range("F24") = ws2.Range("F14")
ws2.Range("F25") = ws2.Range("F15")
ws2.Range("F26") = ws1.Cells(i, 16)
Dim Path As String, mydate As String
ws2.Range("F3") = Date
ws2.Range("F4") = ws1.Cells(i, 2)
ws2.Range("F5") = ws1.Cells(i, 3)




mydate = ws2.Range("F3")
mydate = Format(mydate, "mm_dd_yyyy")

Path = "G:\Test\"
Application.DisplayAlerts = False
ActiveWorkbook.ActiveSheet.SaveAs Filename:=Path & Range("F2") & "-" & Range("A6") & "-" & mydate & ".xlsx", FileFormat:=51
[U]ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & Range("F2") & "-" & Range("A6") & "-" & mydate & ".pdf", OpenAfterPublish:=True[/U]
'ActiveWorkbook.Close SaveChanges:=False
End If

 Next i
' MsgBox myfilename
Application.DisplayAlerts = True
End Sub

 

[Joe4]

Did you try the most recent code I posted in the last post?
It will create multiple PDFs!
I tested it out myself before posting it.

Note that in your posted sample data, you have an error in cell G14.
You should clean that up. Errors in your data could be detrimental in getting your code to run correctly.

 

[Clairexcel]

OK, we need to check to see if a file name already exists. We can incorporate the function found here into your code: VBA Dir Function to Check if File Exists - wellsr.com.

I updated your code to prompt for a new file name if it already exists.
Here is the new code:

Sub getDataSheet1()

    Dim erow As Long
    Dim cliente
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim tenantno As String
    Dim myPath As String, mydate As String
    Dim myFileName As String
    Dim i As Long
   
    Set ws1 = Worksheets("Takings")
    Set ws2 = Worksheets("Invoice")

    erow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    cliente = InputBox("Inserisci nome cliente")

    For i = 4 To erow
        If ws1.Cells(i, 1) = cliente Then
            ws2.Range("F2") = ws1.Cells(i, 1)
            ws2.Range("A7") = ws1.Cells(i, 4)
            ws2.Range("A10") = ws1.Cells(i, 7)
            ws2.Range("E12") = ws1.Cells(i, 23)
            ws2.Range("E13") = ws1.Cells(i, 24)
            ws2.Range("E14") = ws1.Cells(i, 25)
            ws2.Range("E15") = ws1.Cells(i, 26)
            ws2.Range("E16") = ws1.Cells(i, 27)
            ws2.Range("E17") = ws1.Cells(i, 28)
            ws2.Range("F12") = ws1.Cells(i, 30)
            ws2.Range("F13") = ws1.Cells(i, 31)
            ws2.Range("F14") = ws1.Cells(i, 32)
            ws2.Range("F15") = ws1.Cells(i, 33)
            ws2.Range("F16") = ws1.Cells(i, 34)
            ws2.Range("F17") = ws1.Cells(i, 35)

            ws2.Range("F24") = ws2.Range("F14")
            ws2.Range("F25") = ws2.Range("F15")
            ws2.Range("F26") = ws1.Cells(i, 16)
            ws2.Range("F3") = Date
            ws2.Range("F4") = ws1.Cells(i, 2)
            ws2.Range("F5") = ws1.Cells(i, 3)

            mydate = Format(ws2.Range("F3"), "mm_dd_yyyy")

            myPath = "G:\Test\"
            myFileName = Range("F2") & "-" & Range("A6") & "-" & mydate
           
'           Check to see if file name already exists
            Do
                If FileExists(myPath & myFileName & ".pdf") = True Then
'                   Prompt for new file name
                    myFileName = InputBox("FileName:" & myFileName & " already exists." & vbCrLf & "Please enter new filename.")
                Else
                    Exit Do
                End If
            Loop
           
            Application.DisplayAlerts = False
           
            ActiveWorkbook.ActiveSheet.SaveAs Filename:=myPath & myFileName & ".xlsx", FileFormat:=51
            ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myPath & myFileName & ".pdf", OpenAfterPublish:=True
            'ActiveWorkbook.Close SaveChanges:=False
        End If
    Next i

    Application.DisplayAlerts = True

    MsgBox "Macro complete!"
   
End Sub


Function FileExists(FilePath As String) As Boolean
   
    Dim TestStr As String
   
    TestStr = ""
   
    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0
   
    If TestStr = "" Then
        FileExists = False
    Else
        FileExists = True
    End If
   
End Function

Wow I cannnot thank you enough. very much appreciated. Now it works perfectly it opens me 4 pdfs for wvwry row of client Brad Pitt. Genius
It does not work however on Pinco Pallo client. As soon as I enter the name Pinco Pallo, it gives me the message "Macro Complete!". Why do you think is that happening? As you can see from my minisheet Pinco Pallo customer has 10 rows so it should create 10 pdf's..
Another thing is that when he creates pdf's it also saves me the whole wbk as a xlxs file with tha name of the last pdf.
Anyhow, I thank you again very much, never could have done this by myself.

 

[Joe4]

It does not work however on Pinco Pallo client. As soon as I enter the name Pinco Pallo, it gives me the message "Macro Complete!". Why do you think is that happening? As you can see from my minisheet Pinco Pallo customer has 10 rows so it should create 10 pdf's..

Check closely to make sure it matches EXACTLY. Any difference, as simple as an extra space at the end of your data, will cause it not to match.

Another thing is that when he creates pdf's it also saves me the whole wbk as a xlxs file with tha name of the last pdf.

That is because of this line here that you had in your original code:

           ActiveWorkbook.ActiveSheet.SaveAs Filename:=myPath & myFileName & ".xlsx", FileFormat:=51

If you do not want it to re-save the Excel file under a different name, get rid of that row.

 

[Clairexcel]

Check closely to make sure it matches EXACTLY. Any difference, as simple as an extra space at the end of your data, will cause it not to match.


That is because of this line here that you had in your original code:

           ActiveWorkbook.ActiveSheet.SaveAs Filename:=myPath & myFileName & ".xlsx", FileFormat:=51

If you do not want it to re-save the Excel file under a different name, get rid of that row.

Thank you, thank you so much for your help Joe4!

 

[Joe4]

Did you resolve the issue with the "Pinco Pallo" records?
What was the problem?