GrantAstley
01-25-2015, 05:24 AM
Hi
I am trying to use a button to check weather a workbook is open, if it is not open then open it and make changes to that work book in a specific sheet.
The button
- Saves the Quote now as an invoice as a PDF file
- Inserts the Quote No (Which is unique) into the
Workbook - Astleys Electrical, Sheet - Jobs, Cell - I2
it then uses the formula in - I3 formular =7+(MATCH(I2,B8:B1000,0))
to determine which row to add data to and to change the colour of certain cells in that row
Then the VBA program gets this number (Rowx) and uses it to make the changes.
- Makes changes to Astleys Electrical workbook and saves them
- Saves the current workbook
Then once changes are made if the workbook was not open then close it, if it was open then leave it open.
I am getting a runtime error 9 - Script out of range on line
MasterWb.JobsSh.Range("I2").Value = Wb.Sheets("Quote").Range("H4").Value 'Input Quote No so spreadsheet can calc which row to be on
Any help with this problem would be greatly appreciated.
Private Sub Quote_Accepted_PB_Click()
Sheets("Invoice").Visible = True
Dim WbOpen As Boolean
Dim MasterWb As Workbook
Dim JobsSh As Worksheet
Dim Wb As Workbook
Set Wb = ThisWorkbook
Dim Hyper_Name As String
Dim Hyper_Loc As String
Dim Save_Name As String
'Example Saved Name: I-50-2, 02-01-2013, Grant Astley
Save_Name_PDF = Wb.Sheets("Invoice").Range("G4").Value & ", " & Format(Now, "yyyy-mm-dd") & ", " & Wb.Sheets("Invoice").Range("C8").Value & ".pdf"
Hyper_Name = Wb.Sheets("Invoice").Range("G4").Value
Hyper_Loc = "C:\Users\Grant\Documents\Astleys Electrical\Invoices\" & Save_Name_PDF
'Save Invoice as PDF
Wb.Sheets("Invoice").Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Users\Grant\Documents\Astleys Electrical\Invoices\" & Save_Name_PDF, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' Check if Astleys Electrical workbook is open
On Error Resume Next
Set MasterWb = Workbooks("Astleys Electrical.xlsm")
On Error GoTo 0
If MasterWb Is Nothing Then
' If workbook was NOT open, we'll open it
' We'll use the parameter WbOpen to remember whether the workbook was open or not
Set MasterWb = Workbooks.Open("C:\Users\Grant\Documents\Astleys Electrical\Astleys Electrical.xlsm", ReadOnly:=False) 'Open Workbook
WbOpen = False
Else
WbOpen = True
End If
'Find which row to use
Dim Rowx As String
MasterWb.JobsSh.Range("I2").Value = Wb.Sheets("Quote").Range("H4").Value 'Input Quote No so spreadsheet can calc which row to be on
MasterWb.JobsSh.Calculate 'Force Sheet to perform calculations
Rowx = MasterWb.JobsSh.Range("I3").Value 'Make Rowx = calculated row from worksheet
'Change color of Quote Status to green
MasterWb.JobSh.Range(Cells(Rowx, 2)).Interior.ColorIndex = 4
'Insert date quote was accepted and quote date expiry to jobs sheet
MasterWb.JobsSh.Range(Cells(Rowx, 9)).Value = Format(Date, "dd-mmm-yyyy")
MasterWb.JobsSh.Range(Cells(Rowx, 10)).Value = Format(Date + 31, "dd-mmm-yyyy")
'Add hyperlink to Invoice from Master Jobs list
MasterWb.JobsSh.Hyperlinks.Add Anchor:=MasterWb.JobsSh.Range(Cells(Rowx, 3)), _
Address:=Hyper_Loc, _
TextToDisplay:=Hyper_Name
' If Astleys Electrical - Master workbook was NOT open, we'll close it
If WbOpen = False Then MasterWb.Close SaveChanges:=True
'If it was open then we will just save it
if WbOpen = True Then MasterWb.Save
'Set visibility of sheets on current job wb
Wb.Sheets("Test Results").Visible = True
Wb.Sheets("Quote").visibility = False
'Save job workbook now with invoice visible
Wb.Save
End Sub
I am trying to use a button to check weather a workbook is open, if it is not open then open it and make changes to that work book in a specific sheet.
The button
- Saves the Quote now as an invoice as a PDF file
- Inserts the Quote No (Which is unique) into the
Workbook - Astleys Electrical, Sheet - Jobs, Cell - I2
it then uses the formula in - I3 formular =7+(MATCH(I2,B8:B1000,0))
to determine which row to add data to and to change the colour of certain cells in that row
Then the VBA program gets this number (Rowx) and uses it to make the changes.
- Makes changes to Astleys Electrical workbook and saves them
- Saves the current workbook
Then once changes are made if the workbook was not open then close it, if it was open then leave it open.
I am getting a runtime error 9 - Script out of range on line
MasterWb.JobsSh.Range("I2").Value = Wb.Sheets("Quote").Range("H4").Value 'Input Quote No so spreadsheet can calc which row to be on
Any help with this problem would be greatly appreciated.
Private Sub Quote_Accepted_PB_Click()
Sheets("Invoice").Visible = True
Dim WbOpen As Boolean
Dim MasterWb As Workbook
Dim JobsSh As Worksheet
Dim Wb As Workbook
Set Wb = ThisWorkbook
Dim Hyper_Name As String
Dim Hyper_Loc As String
Dim Save_Name As String
'Example Saved Name: I-50-2, 02-01-2013, Grant Astley
Save_Name_PDF = Wb.Sheets("Invoice").Range("G4").Value & ", " & Format(Now, "yyyy-mm-dd") & ", " & Wb.Sheets("Invoice").Range("C8").Value & ".pdf"
Hyper_Name = Wb.Sheets("Invoice").Range("G4").Value
Hyper_Loc = "C:\Users\Grant\Documents\Astleys Electrical\Invoices\" & Save_Name_PDF
'Save Invoice as PDF
Wb.Sheets("Invoice").Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Users\Grant\Documents\Astleys Electrical\Invoices\" & Save_Name_PDF, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' Check if Astleys Electrical workbook is open
On Error Resume Next
Set MasterWb = Workbooks("Astleys Electrical.xlsm")
On Error GoTo 0
If MasterWb Is Nothing Then
' If workbook was NOT open, we'll open it
' We'll use the parameter WbOpen to remember whether the workbook was open or not
Set MasterWb = Workbooks.Open("C:\Users\Grant\Documents\Astleys Electrical\Astleys Electrical.xlsm", ReadOnly:=False) 'Open Workbook
WbOpen = False
Else
WbOpen = True
End If
'Find which row to use
Dim Rowx As String
MasterWb.JobsSh.Range("I2").Value = Wb.Sheets("Quote").Range("H4").Value 'Input Quote No so spreadsheet can calc which row to be on
MasterWb.JobsSh.Calculate 'Force Sheet to perform calculations
Rowx = MasterWb.JobsSh.Range("I3").Value 'Make Rowx = calculated row from worksheet
'Change color of Quote Status to green
MasterWb.JobSh.Range(Cells(Rowx, 2)).Interior.ColorIndex = 4
'Insert date quote was accepted and quote date expiry to jobs sheet
MasterWb.JobsSh.Range(Cells(Rowx, 9)).Value = Format(Date, "dd-mmm-yyyy")
MasterWb.JobsSh.Range(Cells(Rowx, 10)).Value = Format(Date + 31, "dd-mmm-yyyy")
'Add hyperlink to Invoice from Master Jobs list
MasterWb.JobsSh.Hyperlinks.Add Anchor:=MasterWb.JobsSh.Range(Cells(Rowx, 3)), _
Address:=Hyper_Loc, _
TextToDisplay:=Hyper_Name
' If Astleys Electrical - Master workbook was NOT open, we'll close it
If WbOpen = False Then MasterWb.Close SaveChanges:=True
'If it was open then we will just save it
if WbOpen = True Then MasterWb.Save
'Set visibility of sheets on current job wb
Wb.Sheets("Test Results").Visible = True
Wb.Sheets("Quote").visibility = False
'Save job workbook now with invoice visible
Wb.Save
End Sub