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

Clairexcel

New Member
Joined
Mar 23, 2021
Messages
31
Office Version
  1. 2016
  2. 2010
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
VBA Code:
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,957
Office Version
  1. 365
Platform
  1. Windows
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.
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

Clairexcel

New Member
Joined
Mar 23, 2021
Messages
31
Office Version
  1. 2016
  2. 2010
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:
VBA 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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,957
Office Version
  1. 365
Platform
  1. Windows
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:
VBA 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

New Member
Joined
Mar 23, 2021
Messages
31
Office Version
  1. 2016
  2. 2010
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:
VBA 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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,957
Office Version
  1. 365
Platform
  1. Windows
Did you resolve the issue with the "Pinco Pallo" records?
What was the problem?
 

Watch MrExcel Video

Forum statistics

Threads
1,129,803
Messages
5,638,444
Members
417,025
Latest member
MusterDuster

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top