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
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Joe4

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

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

Attachments

  • invoice template path A6 F2.JPG
    invoice template path A6 F2.JPG
    51.9 KB · Views: 2

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,957
Office Version
  1. 365
Platform
  1. Windows
Try adding this error handling code to your procedure, run it, and tell me EXACTLY what the error pop-up message box says:
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")
 
 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

New Member
Joined
Mar 23, 2021
Messages
31
Office Version
  1. 2016
  2. 2010

ADVERTISEMENT

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

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

Attachments

  • Error Joe4 code JPG.JPG
    Error Joe4 code JPG.JPG
    24.9 KB · Views: 2

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,957
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

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

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

Clairexcel

New Member
Joined
Mar 23, 2021
Messages
31
Office Version
  1. 2016
  2. 2010
@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
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJ
2CustomerPartnerProject typeAgents in chargeProject noPaymentProject stageStart dateHours ExpensesExpense supperted byDate expensesStage costTotalCashedn. fatt incasso data fattura incasso Pratica nuova? Saldo incassixxxExpenses Agent 1Expenses Agent 2Fees Agent 1Fees Agent 2Fees Agent 3Fees Agent 4Fees Agent 5Fees Agent 6Colonna10Fees Agent1Fees Agent2Fees Agent3Fees Agent4Fees Agent5Fees Agent6Colonna108
3Pinco PalloPinca Pallatype 1Gabriel- Stefania-Valeria-Valentina-Alan1102233RateStesura10/03/202181500SISaldo incassi04507575450450450FALSO150000000FALSO1500
4Pinco Pallo Pinca Pallatype 1Gabriel- Stefania-Valeria-Valentina-Alan1102233RateDisamina12/03/2021845G12/03/2021250295200,00XXX15/03/2020120520045014,7514,7588,588,588,5FALSO2951010606060FALSO295
5Pinco Pallo Pinca Pallatype 1Gabriel- Stefania-Valeria-Valentina-Alan1102233RateStesura02000000000FALSO000000FALSO0
6Pinco Pallo Pinca Pallatype 1Gabriel- Stefania-Valeria-Valentina-Alan1102233Rate000000FALSO000000FALSO0
7Pinco Pallo Pinca Pallatype 1Gabriel- Stefania-Valeria-Valentina-Alan1102233Rate000000FALSO000000FALSO0
8Pinco Pallo Pinca Pallatype 1Gabriel- Stefania-Valeria-Valentina-Alan1102233Rate000000FALSO000000FALSO0
9Pinco Pallo Pinca Pallatype 1Gabriel- Stefania-Valeria-Valentina-Alan1102233Rate000000FALSO000000FALSO0
10Pinco Pallo Pinca Pallatype 1Gabriel- Stefania-Valeria-Valentina-Alan1102233Rate000000FALSO000000FALSO0
11Pinco Pallo Pinca Pallatype 1Gabriel- Stefania-Valeria-Valentina-Alan1102233Rate000000FALSO000000FALSO0
12Pinco Pallo Pinca Pallatype 1Gabriel- Stefania-Valeria-Valentina-Alan1102233Rate000000FALSO000000FALSO0
13Pinco Pallo Pinca Pallatype 1Gabriel- Stefania-Valeria-Valentina-Alan1102233Rate000000FALSO000000FALSO0
14Brad PittAngelina Jolietype 15Gabriel- Valeria- Valentina44270Rate#RIF!15/03/20211400FALSO00FALSOFALSO00FALSO00FALSOFALSO0
15Brad PittAngelina Jolietype 15Gabriel- Valeria- Valentina44270Ratelettera inviata a controparte16/03/202130500500450,00100FALSO150150FALSOFALSO40090FALSO135135FALSOFALSO400
16Brad PittAngelina Jolietype 15Gabriel- Valeria- Valentina44270RateStesura18/03/2021500FALSO00FALSOFALSO00FALSO00FALSOFALSO0
17Brad PittAngelina Jolietype 15Gabriel- Valeria- Valentina44270RateConciliazione21/03/20216000
18     000
19000
Takings
Cell Formulas
RangeFormula
G3G3=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)
I3I3=SUM(I4:I13)
T3:T4T3=Tabella13[[#This Row],[Cashed]]
U3:U5U3=SUMIF($K3:$K12,"*G*",$J3:$J12)
V3:V5V3=SUMIF($K3:$K12,"*S*",$J3:$J12)
T5T5=Tabella13[[#This Row],[Cashed]]+T4
W3:W16W3=IF(ISNUMBER(SEARCH("Gabr",$D3)),((($N3-($Y3+$Z3+$AA3+$AB3))/2)))
X3:X16X3=IF(ISNUMBER(SEARCH("Stef",$D3)),((($N3-($Y3+$Z3+$AA3+$AB3))/2)))
Y3:Y16Y3=IF(ISNUMBER(SEARCH("Valeri",$D3)),(($N3-(($N3*((1-30%)))))))
Z3:Z16Z3=IF(ISNUMBER(SEARCH("Valen",$D3)),(($N3-(($N3*((1-30%)))))))
AA3:AA16AA3=IF(ISNUMBER(SEARCH("Alan1",$D3)),(($N3-(($N3*((1-30%)))))))
AB3:AB16AB3=IF(ISNUMBER(SEARCH("Alan2",$D3)),(($M3-(($M3*((1-30%)))))))
AD3:AD16AD3=IF(ISNUMBER(SEARCH("Gabr",$D3)),((($O3-($AF3+$AG3+$AH3+$AI3))/2)))
AE3:AE16AE3=IF(ISNUMBER(SEARCH("Stef",$D3)),((($O3-($AF3+AG3+$AH3+$AI3))/2)))
AF3:AF16AF3=IF(ISNUMBER(SEARCH("Valeri",$D3)),(($O3-(($O3*((1-30%)))))))
AG3:AG16AG3=IF(ISNUMBER(SEARCH("Valen",$D3)),(($O3-(($O3*((1-30%)))))))
AH3:AH16AH3=IF(ISNUMBER(SEARCH("Alan1",$D3)),(($O3-(($O3*((1-30%)))))))
AI3:AI16AI3=IF(ISNUMBER(SEARCH("Alan2",$D3)),(($O3-(($O3*((1-30%)))))))
B15:F15,A5:F13,E4:F4,B4:C4B4=IF(B3<>"",B3,"")
S4S4=N3-(N4:N13)
G14G14=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)
I14I14=SUM(I15:I18)
B16:F17B16=IF($A16<>"",B15,"")
B18:F18B18=IF($A18=$A17,B17,"")
N4:N19N4=Tabella13[[#This Row],[Stage cost]]+Tabella13[[#This Row],[Expenses]]
AJ3:AJ19,AC3:AC19AC3=SUM(Tabella13[[#This Row],[Fees Agent 1]:[Fees Agent 6]])
 

Watch MrExcel Video

Forum statistics

Threads
1,129,801
Messages
5,638,437
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