VBA Help

trstbmbk4me

New Member
Joined
Sep 17, 2023
Messages
9
Office Version
  1. 365
Platform
  1. Windows
I have followed a video series on youtube to create an invoice. That invoice has buttons to do macros/vba. it works very well and I am almost happy with it.

One of the buttons is to save the invoice as a PDF the other button saves as a .xlsx file. Each of these work and paste the hyperlink onto the order records sheet. However, clicking the two seperate buttons saves it on two different lines when it should be on the same line.

The series I followed and enjoyed was https://www.youtube.com/playlist?list=PLA3JEasWtYad0OeX78k0gFhxm5qnnaD57.

The VBA used for the two functions are as follows:

Sub SaveAsPdf()

Dim invno As Long
Dim custname As String
Dim amt As Currency
Dim dt_issue As Date
Dim term As Byte
Dim path As String
Dim fname As String
Dim nextrec As Range

invno = Range("C3")
custname = Range("B10")
amt = Range("I41")
dt_issue = Range("C5")
term = Range("C6")
path = "C:\Users\rhond\OneDrive\Desktop\trial inv for matt\"
fname = invno & " _ " & custname

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, ignoreprintareas:=False, Filename:=path & fname

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

nextrec = invno
nextrec.Offset(0, 1) = custname
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue
nextrec.Offset(0, 4) = dt_issue + term

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=path & fname & ".pdf"


End Sub



Sub SaveInvAsExcel()

Dim invno As Long
Dim custname As String
Dim amt As Currency
Dim dt_issue As Date
Dim term As Byte
Dim path As String
Dim fname As String
Dim nextrec As Range

invno = Range("C3")
custname = Range("B10")
amt = Range("I41")
dt_issue = Range("C5")
term = Range("C6")
path = "C:\Users\rhond\OneDrive\Desktop\trial inv for matt\"
fname = invno & " _ " & custname


'copy the invoice sheet to a new workbook

Sheet1.Copy

'delete all the buttons on the worksheet

Dim shp As Shape

For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp

'save the new workbook to a specified folder
With ActiveWorkbook
.Sheets(1).Name = "Invoice"
.SaveAs Filename:=path & fname, FileFormat:=51
.Close

End With


'need to put the details of the invoice in the record of invoices sheet

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

nextrec = invno
nextrec.Offset(0, 1) = custname
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue
nextrec.Offset(0, 4) = dt_issue + term

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 7), Address:=path & fname & ".xlsx"


End Sub

I can't for the life of me figure out how to put both of these in different cells in the same row. Any ideas?
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Let's start here. This worked on my machine.
VBA Code:
Sub SaveAsPdf()

Dim invno As Long
Dim custname As String
Dim amt As Currency
Dim dt_issue As Date
Dim term As Byte
Dim path As String
Dim fname As String
Dim nextrec As Range

invno = Range("C3")
custname = Range("B10")
amt = Range("I41")
dt_issue = Range("C5")
term = Range("C6")
path = "C:\Users\rhond\OneDrive\Desktop\trial inv for matt\"
fname = invno & " _ " & custname

'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, ignoreprintareas:=False, Filename:=path & fname

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

nextrec = invno
nextrec.Offset(0, 1) = custname
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue
nextrec.Offset(0, 4) = dt_issue + term

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=path & fname & ".pdf"

SaveInvAsExcel
End Sub



Sub SaveInvAsExcel()

Dim invno As Long
Dim custname As String
'Dim amt As Currency
'Dim dt_issue As Date
'Dim term As Byte
Dim path As String
Dim fname As String
Dim nextrec As Range

invno = Range("C3")
custname = Range("B10")
'amt = Range("I41")
'dt_issue = Range("C5")
'term = Range("C6")
path = "C:\Users\rhond\OneDrive\Desktop\trial inv for matt\"
fname = invno & " _ " & custname


'copy the invoice sheet to a new workbook

'Sheet1.Copy

'delete all the buttons on the worksheet

'Dim shp As Shape

'For Each shp In ActiveSheet.Shapes
'shp.Delete
'Next shp

'need to put the details of the invoice in the record of invoices sheet

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

'nextrec = invno
'nextrec.Offset(0, 1) = custname
'nextrec.Offset(0, 2) = amt
'nextrec.Offset(0, 3) = dt_issue
'nextrec.Offset(0, 4) = dt_issue + term

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(-1, 7), Address:=path & fname & ".xlsx"

'save the new workbook to a specified folder
Application.DisplayAlerts = False
With ActiveWorkbook
.Sheets(1).Name = "Invoice"
.SaveAs Filename:=path & fname, FileFormat:=51
'.Close

End With
Application.DisplayAlerts = True

End Sub
 
Upvote 0
Let's start here. This worked on my machine.
VBA Code:
Sub SaveAsPdf()

Dim invno As Long
Dim custname As String
Dim amt As Currency
Dim dt_issue As Date
Dim term As Byte
Dim path As String
Dim fname As String
Dim nextrec As Range

invno = Range("C3")
custname = Range("B10")
amt = Range("I41")
dt_issue = Range("C5")
term = Range("C6")
path = "C:\Users\rhond\OneDrive\Desktop\trial inv for matt\"
fname = invno & " _ " & custname

'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, ignoreprintareas:=False, Filename:=path & fname

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

nextrec = invno
nextrec.Offset(0, 1) = custname
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue
nextrec.Offset(0, 4) = dt_issue + term

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=path & fname & ".pdf"

SaveInvAsExcel
End Sub



Sub SaveInvAsExcel()

Dim invno As Long
Dim custname As String
'Dim amt As Currency
'Dim dt_issue As Date
'Dim term As Byte
Dim path As String
Dim fname As String
Dim nextrec As Range

invno = Range("C3")
custname = Range("B10")
'amt = Range("I41")
'dt_issue = Range("C5")
'term = Range("C6")
path = "C:\Users\rhond\OneDrive\Desktop\trial inv for matt\"
fname = invno & " _ " & custname


'copy the invoice sheet to a new workbook

'Sheet1.Copy

'delete all the buttons on the worksheet

'Dim shp As Shape

'For Each shp In ActiveSheet.Shapes
'shp.Delete
'Next shp

'need to put the details of the invoice in the record of invoices sheet

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

'nextrec = invno
'nextrec.Offset(0, 1) = custname
'nextrec.Offset(0, 2) = amt
'nextrec.Offset(0, 3) = dt_issue
'nextrec.Offset(0, 4) = dt_issue + term

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(-1, 7), Address:=path & fname & ".xlsx"

'save the new workbook to a specified folder
Application.DisplayAlerts = False
With ActiveWorkbook
.Sheets(1).Name = "Invoice"
.SaveAs Filename:=path & fname, FileFormat:=51
'.Close

End With
Application.DisplayAlerts = True

End Sub
Yeah! It worked! So, what did you change/do? I have been stuck on this for days!
 
Upvote 0
After seeing your data it was easier for me to visualize what you were trying to do, so I commented out a few lines and changed when the Workbook was saved as Excel. To be honest, I didn't think the first iteration was going to work, so there is no way it can be working 100% because the PDF save is commented out, and once it's saved as Excel you're in the Saved Excel Workbook and not in the original Invoice file (which is where I assume you want to be so that you can make additional Invoices). When I get home from work today I will clean up the code re-submit.
 
Upvote 0
Try this. I want to expand on this but I want to make sure it's working on your machine.
VBA Code:
Sub SaveAsPdf()

Dim invno As Long
Dim custname As String
Dim amt As Currency
Dim dt_issue As Date
Dim term As Byte
Dim path As String
Dim fname As String
Dim nextrec As Range, cell As Range
Dim lRow As Long
Dim invWb As Workbook, invSht1 As Worksheet, invSht3 As Worksheet
Dim newWb As Workbook, newSht As Worksheet

Set invWb = ThisWorkbook: Set invSht1 = invWb.Sheets(1): Set invSht3 = invWb.Sheets(3)
For Each cell In invSht3.Columns(1).Cells
    If cell.Value = "" Then
        lRow = cell.Row
        Exit For
    End If
Next cell
    
Set nextrec = invSht3.Range("A" & lRow)

invno = invSht1.Range("C3").Value
custname = invSht1.Range("B10").Value
amt = invSht1.Range("I41").Value
dt_issue = invSht1.Range("C5").Value
term = invSht1.Range("C6").Value
path = "C:\Users\rhond\OneDrive\Desktop\trial inv for matt\"
fname = invno & " _ " & custname

nextrec.Value = invno
nextrec.Offset(0, 1).Value = custname
nextrec.Offset(0, 2).Value = amt
nextrec.Offset(0, 3).Value = dt_issue
nextrec.Offset(0, 4).Value = dt_issue + term
invSht3.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=path & fname & ".pdf"
invSht3.Hyperlinks.Add anchor:=nextrec.Offset(0, 7), Address:=path & fname & ".xlsx"

Set newWb = Workbooks.Add
Set newSht = newWb.Sheets(1)
newSht.Name = "Invoice"
invSht1.Cells.Copy
newSht.Paste
newSht.SaveAs Filename:=path & fname, FileFormat:=51
newWb.Close
invSht1.ExportAsFixedFormat Type:=xlTypePDF, ignoreprintareas:=False, Filename:=path & fname

End Sub

Sub CreateNewInvoice()

Dim invno As Long

invno = Range("C3")

Range("C4:D6, B10").ClearContents

MsgBox "Your next invoice number is " & invno + 1

Range("C3") = invno + 1

Range("C5").Value = "=TODAY()"

Range("B10").Select

ThisWorkbook.Save



End Sub
 
Upvote 0
Try this. I want to expand on this but I want to make sure it's working on your machine.
VBA Code:
Sub SaveAsPdf()

Dim invno As Long
Dim custname As String
Dim amt As Currency
Dim dt_issue As Date
Dim term As Byte
Dim path As String
Dim fname As String
Dim nextrec As Range, cell As Range
Dim lRow As Long
Dim invWb As Workbook, invSht1 As Worksheet, invSht3 As Worksheet
Dim newWb As Workbook, newSht As Worksheet

Set invWb = ThisWorkbook: Set invSht1 = invWb.Sheets(1): Set invSht3 = invWb.Sheets(3)
For Each cell In invSht3.Columns(1).Cells
    If cell.Value = "" Then
        lRow = cell.Row
        Exit For
    End If
Next cell
   
Set nextrec = invSht3.Range("A" & lRow)

invno = invSht1.Range("C3").Value
custname = invSht1.Range("B10").Value
amt = invSht1.Range("I41").Value
dt_issue = invSht1.Range("C5").Value
term = invSht1.Range("C6").Value
path = "C:\Users\rhond\OneDrive\Desktop\trial inv for matt\"
fname = invno & " _ " & custname

nextrec.Value = invno
nextrec.Offset(0, 1).Value = custname
nextrec.Offset(0, 2).Value = amt
nextrec.Offset(0, 3).Value = dt_issue
nextrec.Offset(0, 4).Value = dt_issue + term
invSht3.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=path & fname & ".pdf"
invSht3.Hyperlinks.Add anchor:=nextrec.Offset(0, 7), Address:=path & fname & ".xlsx"

Set newWb = Workbooks.Add
Set newSht = newWb.Sheets(1)
newSht.Name = "Invoice"
invSht1.Cells.Copy
newSht.Paste
newSht.SaveAs Filename:=path & fname, FileFormat:=51
newWb.Close
invSht1.ExportAsFixedFormat Type:=xlTypePDF, ignoreprintareas:=False, Filename:=path & fname

End Sub

Sub CreateNewInvoice()

Dim invno As Long

invno = Range("C3")

Range("C4:D6, B10").ClearContents

MsgBox "Your next invoice number is " & invno + 1

Range("C3") = invno + 1

Range("C5").Value = "=TODAY()"

Range("B10").Select

ThisWorkbook.Save



End Sub
It appears to be working just fine. Thank you.
 
Upvote 0
Hello, I am in the same boat as the person who started this thread. At the moment, I cannot have the saved files with the extension (Fileformat:=51). It saves it without extension. I need to specify that I am on MAC OS.

I don't know if this makes a difference, but on my invoice sheet, I have a QR code that is generated as the information gets filled in. I did not set up a button for it, I added the image function and the information used for this function are on other cells that I hide. This QR code generator uses an API (for bank payment via QR code)

When I run the SaveInvAsExcel (), it does what it is supposed to do, but the saved file is missing the extension (.xlsx)

Anyone can guide me towards a solution?

This is the Macro I have issues with:

Sub SaveInvAsExcel()

Dim invno As Long
Dim custname As String
Dim amt As Currency
Dim dt_issue As Date
Dim term As Long
Dim path As String
Dim fname As String
Dim nextrec As Range


invno = Range("G1")
custname = Range("E13")
amt = Range("H37")
dt_issue = Range("B19")
term = Range("B20")
path = "/Users/rodsmacbook14m1pro/Library/CloudStorage/OneDrive-Madhouses.r.o/Desktop/NUPEAKS/ACCOUNTING/2024/ACCOUNTANT DOCS/INCOMES INVOICES/EXCEL INVOICES/"
fname = invno & " _ " & custname


'copy the invoice sheet to a new workbook

Sheet1.Copy


'then delete all the buttons on the worksheet

Dim shp As Shape

For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp


'save the new workbook to a specified folder

With ActiveWorkbook
.Sheets(1).Name = "Invoice"
.SaveAs FileName:=path & fname, FileFormat:=51
.Close

End With

'need to put the details of the invoice in the record of invoices sheet

Set nextrec = Sheet3.Range("A104876").End(xlUp).Offset(1, 0)

nextrec = invno
nextrec.Offset(0, 1) = custname
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue
nextrec.Offset(0, 4) = term

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 7), Address:=path & fname & ".xlsx"



End Sub
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,206
Members
452,618
Latest member
Tam84

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
Back
Top