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]

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...

You mention multiple rows with the same customer name and trying to produce multiple PDFs.
Are you, perchance, trying to give multiple PDF files the same file name, and that is why you are getting errors?

Here is the part of the line of code that builds the file name:

Filename:=Path & Range("F2") & "-" & Range("A6") & "-" & mydate & ".pdf"

On the line that returns the error, can you tell us exactly what cells A6 and F2 are equal to when the error occurs?

 

[Clairexcel]

You mention multiple rows with the same customer name and trying to produce multiple PDFs.
Are you, perchance, trying to give multiple PDF files the same file name, and that is why you are getting errors?

Here is the part of the line of code that builds the file name:

Filename:=Path & Range("F2") & "-" & Range("A6") & "-" & mydate & ".pdf"

On the line that returns the error, can you tell us exactly what cells A6 and F2 are equal to when the error occurs?

@Joe4 thank you for you kind reply.
The range A6 and F2 equal as follows (I also Attach the screenshot of the invoice sheet):
F2 reports the customer name for which I "call" the data into the invoice template
A6 reports the Agents involved in this customer's project
As for the name to give to the pdf files, the error occurs right after the macro fills the invoice template and publishes the pdf file. SO I do not give a name to the pdf file, because error has already occured and asks for debug of this line :
ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & Range("F2") & "-" & Range("A6") & "-" & mydate & ".pdf", OpenAfterPublish:=True
Another thing I noticed is that whenever I run tha macro, the excel workbook changes the name and is named automatically and becomes folder name followed by the customer name for which I called the macro.
I can get to solve this macro and get it to work right...
Appreciate your help

 

[Joe4]

Try adding this error handling code to your procedure, run it, and tell me EXACTLY what the error pop-up message box says:

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")
 
 On Error GoTo err_chk
 
 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
ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & Range("F2") & "-" & Range("A6") & "-" & mydate & ".pdf", OpenAfterPublish:=True
'ActiveWorkbook.Close SaveChanges:=False
End If

 Next i
' MsgBox myfilename
Application.DisplayAlerts = True

Exit Sub

err_chk:
    MsgBox Err.Number & ": " & Err.Description & vbCrLf & _
            "Filename: " & Path & Range("F2") & "-" & Range("A6") & "-" & mydate & ".pdf" & vbCrLf & _
            "Row number: " & i

End Sub

 

[Clairexcel]

Ok, I ran the code you gave me and it gives me the error I attach in the screen shot. It does not give me the debug option though nor it highlight code lines. It only signlas the row...

 

[Clairexcel]

Ok, I ran the code you gave me and it gives me the error I attach in the screen shot. It does not give me the debug option though nor it highlight code lines. It only signlas the row...

Sorry I forgot to attach the error's screenshot

 

[Joe4]

OK, with the details listed in that message, can you confirm:
1. Is the path listed in the file name valid? Are able to browse to it and write to it?
2. Is there already file in that folder with the file name listed in that message?
3. Did any PDF file get created and written to the folder at all?

 

[Clairexcel]

OK, with the details listed in that message, can you confirm:
1. Is the path listed in the file name valid? Are able to browse to it and write to it?
2. Is there already file in that folder with the file name listed in that message?
3. Did any PDF file get created and written to the folder at all?

I will try to answer in order:
1. By path you mean the computer address of the folder? Then yes is correct; in the code I posted I wrote test, but of course before I ran the code you gave me I wrote the correct address. WHat do you mean if "able to browse and write to it?"
2. Yes, and that is a problem. There are fiIes with the same name, form my previous attempts to transfer data into invoice template and then to pdf and they save automatically in that folder. I expected the pdf to open but then to be saved with a name by me. nstead, it opens and it already has a name, and it also changes the name of my workbook, and I do not want this to happen.
3.Yes, please see above

 

[Joe4]

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

 

[Clairexcel]

@Joe4 I post the minisheet below, so that you can see the takings data that I wanted to transfer into the Invoice sheet. As you can see, a Customer may have many rows, so for each row the code should open a pdf (which it use to do until last week)..

Tracking projects Agent1- wip.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ
2	Customer	Partner	Project type	Agents in charge	Project no	Payment	Project stage	Start date	Hours	Expenses	Expense supperted by	Date expenses	Stage cost	Total	Cashed	n. fatt incasso	data fattura incasso	Pratica nuova?	Saldo incassi	xxx	Expenses Agent 1	Expenses Agent 2	Fees Agent 1	Fees Agent 2	Fees Agent 3	Fees Agent 4	Fees Agent 5	Fees Agent 6	Colonna10	Fees Agent1	Fees Agent2	Fees Agent3	Fees Agent4	Fees Agent5	Fees Agent6	Colonna108
3	Pinco Pallo	Pinca Palla	type 1	Gabriel- Stefania-Valeria-Valentina-Alan1	102233	Rate	Stesura	10/03/2021	8					1500				SI	Saldo incassi	0	45	0	75	75	450	450	450	FALSO	1500	0	0	0	0	0	FALSO	1500
4	Pinco Pallo	Pinca Palla	type 1	Gabriel- Stefania-Valeria-Valentina-Alan1	102233	Rate	Disamina	12/03/2021	8	45	G	12/03/2021	250	295	200,00	XXX	15/03/2020		1205	200	45	0	14,75	14,75	88,5	88,5	88,5	FALSO	295	10	10	60	60	60	FALSO	295
5	Pinco Pallo	Pinca Palla	type 1	Gabriel- Stefania-Valeria-Valentina-Alan1	102233	Rate	Stesura							0						200	0	0	0	0	0	0	0	FALSO	0	0	0	0	0	0	FALSO	0
6	Pinco Pallo	Pinca Palla	type 1	Gabriel- Stefania-Valeria-Valentina-Alan1	102233	Rate								0									0	0	0	0	0	FALSO	0	0	0	0	0	0	FALSO	0
7	Pinco Pallo	Pinca Palla	type 1	Gabriel- Stefania-Valeria-Valentina-Alan1	102233	Rate								0									0	0	0	0	0	FALSO	0	0	0	0	0	0	FALSO	0
8	Pinco Pallo	Pinca Palla	type 1	Gabriel- Stefania-Valeria-Valentina-Alan1	102233	Rate								0									0	0	0	0	0	FALSO	0	0	0	0	0	0	FALSO	0
9	Pinco Pallo	Pinca Palla	type 1	Gabriel- Stefania-Valeria-Valentina-Alan1	102233	Rate								0									0	0	0	0	0	FALSO	0	0	0	0	0	0	FALSO	0
10	Pinco Pallo	Pinca Palla	type 1	Gabriel- Stefania-Valeria-Valentina-Alan1	102233	Rate								0									0	0	0	0	0	FALSO	0	0	0	0	0	0	FALSO	0
11	Pinco Pallo	Pinca Palla	type 1	Gabriel- Stefania-Valeria-Valentina-Alan1	102233	Rate								0									0	0	0	0	0	FALSO	0	0	0	0	0	0	FALSO	0
12	Pinco Pallo	Pinca Palla	type 1	Gabriel- Stefania-Valeria-Valentina-Alan1	102233	Rate								0									0	0	0	0	0	FALSO	0	0	0	0	0	0	FALSO	0
13	Pinco Pallo	Pinca Palla	type 1	Gabriel- Stefania-Valeria-Valentina-Alan1	102233	Rate								0									0	0	0	0	0	FALSO	0	0	0	0	0	0	FALSO	0
14	Brad Pitt	Angelina Jolie	type 15	Gabriel- Valeria- Valentina	44270	Rate	#RIF!	15/03/2021	14					0									0	FALSO	0	0	FALSO	FALSO	0	0	FALSO	0	0	FALSO	FALSO	0
15	Brad Pitt	Angelina Jolie	type 15	Gabriel- Valeria- Valentina	44270	Rate	lettera inviata a controparte	16/03/2021	3	0			500	500	450,00								100	FALSO	150	150	FALSO	FALSO	400	90	FALSO	135	135	FALSO	FALSO	400
16	Brad Pitt	Angelina Jolie	type 15	Gabriel- Valeria- Valentina	44270	Rate	Stesura	18/03/2021	5					0									0	FALSO	0	0	FALSO	FALSO	0	0	FALSO	0	0	FALSO	FALSO	0
17	Brad Pitt	Angelina Jolie	type 15	Gabriel- Valeria- Valentina	44270	Rate	Conciliazione	21/03/2021	6					0															0							0
18														0															0							0
19														0															0							0
Takings

Cell Formulas
Range	Formula
G3	G3	=IF(G13="",IF(G12="",IF(G11="",IF(G10="",IF(G9="",IF(G8="",IF(G7="", IF(G6="",IF(G5="",IF(G4="","NON INIZIATA",G4),G5),G6),G7),G8),G9),G10),G11),G12),G13)
I3	I3	=SUM(I4:I13)
T3:T4	T3	=Tabella13[[#This Row],[Cashed]]
U3:U5	U3	=SUMIF($K3:$K12,"*G*",$J3:$J12)
V3:V5	V3	=SUMIF($K3:$K12,"*S*",$J3:$J12)
T5	T5	=Tabella13[[#This Row],[Cashed]]+T4
W3:W16	W3	=IF(ISNUMBER(SEARCH("Gabr",$D3)),((($N3-($Y3+$Z3+$AA3+$AB3))/2)))
X3:X16	X3	=IF(ISNUMBER(SEARCH("Stef",$D3)),((($N3-($Y3+$Z3+$AA3+$AB3))/2)))
Y3:Y16	Y3	=IF(ISNUMBER(SEARCH("Valeri",$D3)),(($N3-(($N3*((1-30%)))))))
Z3:Z16	Z3	=IF(ISNUMBER(SEARCH("Valen",$D3)),(($N3-(($N3*((1-30%)))))))
AA3:AA16	AA3	=IF(ISNUMBER(SEARCH("Alan1",$D3)),(($N3-(($N3*((1-30%)))))))
AB3:AB16	AB3	=IF(ISNUMBER(SEARCH("Alan2",$D3)),(($M3-(($M3*((1-30%)))))))
AD3:AD16	AD3	=IF(ISNUMBER(SEARCH("Gabr",$D3)),((($O3-($AF3+$AG3+$AH3+$AI3))/2)))
AE3:AE16	AE3	=IF(ISNUMBER(SEARCH("Stef",$D3)),((($O3-($AF3+AG3+$AH3+$AI3))/2)))
AF3:AF16	AF3	=IF(ISNUMBER(SEARCH("Valeri",$D3)),(($O3-(($O3*((1-30%)))))))
AG3:AG16	AG3	=IF(ISNUMBER(SEARCH("Valen",$D3)),(($O3-(($O3*((1-30%)))))))
AH3:AH16	AH3	=IF(ISNUMBER(SEARCH("Alan1",$D3)),(($O3-(($O3*((1-30%)))))))
AI3:AI16	AI3	=IF(ISNUMBER(SEARCH("Alan2",$D3)),(($O3-(($O3*((1-30%)))))))
B15:F15,A5:F13,E4:F4,B4:C4	B4	=IF(B3<>"",B3,"")
S4	S4	=N3-(N4:N13)
G14	G14	=IF(G23="",IF(G22="",IF(G21="",IF(G20="",IF(G19="",IF(#REF!="",IF(G18="", IF(G17="",IF(G16="",IF(G15="","NON INIZIATA",G15),G16),G17),G18),#REF!),G19),G20),G21),G22),G23)
I14	I14	=SUM(I15:I18)
B16:F17	B16	=IF($A16<>"",B15,"")
B18:F18	B18	=IF($A18=$A17,B17,"")
N4:N19	N4	=Tabella13[[#This Row],[Stage cost]]+Tabella13[[#This Row],[Expenses]]
AJ3:AJ19,AC3:AC19	AC3	=SUM(Tabella13[[#This Row],[Fees Agent 1]:[Fees Agent 6]])