Calling Masterlist Unsuccessfully

[jjgaiser]

Hello, I'm having a heck of an issue with this. I'm using a form that I created in excel that has a command button. When the command button is clicked it then creates a new worksheet thats identical to the form and saves with its own #. It also calls up a masterspreadsheet that each document can be viewed by a hyperlink...this is when the coding below starts. My problem is where the code begins:
Set MasterList = Workbooks.Open("C:\jobtest\JobOrderMasterList.xlsm")....I'm constantly getting a timeout error in this section. If I could get some advice on this that would be great! Below is the script that I'm using:

'Updates Job Orders Masterlist
Dim CreationDate As Date
Dim JobOrder As String
Dim CompanyName As String
Dim Jobtype As String
Dim MasterList As Workbook
Dim strFolder As String




Worksheets("Quote").Select
CreationDate = Range("H3")
JobOrder = Range("J10")
Worksheets("Quote").Select
CompanyName = Range("B3")
Worksheets("Quote").Select
Jobtype = Range("B3")
strFolder = "C:\jobtest\Quote" & JobOrder & ".xlsm"




Set MasterList = Workbooks.Open("C:\jobtest\JobOrderMasterList.xlsm")
Worksheets("Quote").Select
Worksheets("Quote").Range("A1").Select
RowCount = Worksheets("Quote").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Quote").Range("A1")
.Offset(RowCount, 0) = CreationDate
.Offset(RowCount, 1) = JobOrder
.Offset(RowCount, 2) = CompanyName
.Offset(RowCount, 3) = Jobtype
.Offset(RowCount, 1).Activate
End With
ActiveCell.Hyperlinks.Add ActiveCell, strFolder
MasterList.Save
MasterList.Close

 

[RCBricker]

questions...

what workbook has the worksheet ("Quote") in it? the master workbook or the workbook with the command button

 

[jjgaiser]

JobOrders.xlsm workbook with the command in it

 

[RCBricker]

OK based on what I am reading you code does the following things:

Selects worksheet Quote
Sets Date variable Creationdate to worksheet Quote cell H3
Sets String variable JobOrder to worksheet Quote cell J10
Re-Selects worksheet Quote
Sets String variable CompanyName to worksheet Quote cell B3
Re-Selects worksheet Quote
Sets String variable JobType to worksheet Quote cell B3

*******************************************************************************
cell B3 on worksheet Quote is now referenced in two separate variables jobtype & CompanyName
*******************************************************************************

Sets String variable StrFolder to Path "C:\jobtest\Quote" & JobOrder & ".xlsm"

Sets workbook variable to JobOrderMasterList.xlsm and opens it
Re-Selects worksheet Quote
Selects cell A1 of work sheet Quote.
Sets rowcount variable to row count of current region of worksheet Quote

*******************************************************************************
Rowcount variable is not dimmed
*******************************************************************************

Now a with block for worksheet Quote cell A1
Offset by rowcount only = creationdate
Offset by rowcount and one column to the right = joborder
Offset by rowcount and two columns to the right =companyname
Offset by rowcount and three columns to the right = jobtype
Finally activate cell offset by rowcount and one column to the right

Creates a hyperlink in activated cell to the folder path stored in strfolder

Save masterlist file and then closes it

Also you should turn on Option explicit as it will help control variable declaration.

Rich

 

[RCBricker]

Here is code that does what I think. There are a couple comments directing your attention to the two variables siting the same cell. Also note I removed the selects from your code. I do use them once in a while (especially if I am going to get last row and column in a sheet - I like to make certain the correct sheet is being worked), however, best practice is to never use them.

Sub master()
'Updates Job Orders Masterlist
Dim CreationDate As Date
Dim JobOrder As String, CompanyName As String, Jobtype As String, _
    strFolder As String
Dim MasterList As Workbook, wbcode As Workbook
Dim rowcount As Long
Dim WsQuote As Worksheet, wsDest As Worksheet

    Set wbcode = ThisWorkbook
    Set WsQuote = wbcode.Sheets("Master")
    
    CreationDate = WsQuote.Range("H3")
    JobOrder = WsQuote.Range("J10")
    CompanyName = WsQuote.Range("B3") 'First variable set to B3
    Jobtype = WsQuote.Range("B3")   'second variable set to B3
    
    strFolder = "C:\jobtest\Quote" & JobOrder & ".xlsm"
    
    Set MasterList = Workbooks.Open("C:\jobtest\JobOrderMasterList.xlsm")
    Set wsDest = MasterList.Sheets("Sheet1") 'change this to sheet in master the data is going into
    
     rowcount = wsDest.Range("A" & .Rows.Count).End(xlUp).Offset(1).Row
     With wsDest.Range("A" & rowcount)
        .Value = CreationDate
        .Offset(, 1).Value = JobOrder
        .Offset(, 2).Value = CompanyName
        .Offset(, 3).Value = Jobtype
     End With
     ActiveCell.Hyperlinks.Add wsDest.Range("A" & rowcount), strFolder
     MasterList.Save
     MasterList.Close
     
End Sub

change the sheet names to the ones you need to work. I set the destination worksheet in masterlist as sheet1

 

[jjgaiser]

Here is the full VBA script...


Private Sub CommandButton1_Click()
' Next Quote Number
Range("J10").Value = Range("J10").Value + 1


' Next TM Number
Range("J9").Value = Range("J9").Value + 1


'Current date
Sheets("Quote").Range("H3"). _
Value = Format(Now, "mm/dd/yy")


' Copy Invoice to a new workbook
Dim NewFN As Variant
ActiveSheet.Copy
NewFN = "C:\jobtest\Quote" & Range("J10").Value & ".xlsm"
ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbookMacroEnabled




'Updates Job Orders Masterlist
Dim CreationDate As Date
Dim JobOrder As String
Dim CompanyName As String
Dim Jobtype As String
Dim MasterList As Workbook
Dim strFolder As String




Worksheets("Quote").Select
CreationDate = Range("H3")
JobOrder = Range("J10")
Worksheets("Quote").Select
CompanyName = Range("B3")
Worksheets("Quote").Select
Jobtype = Range("B3")
strFolder = "C:\jobtest\Quote" & JobOrder & ".xlsm"




Set MasterList = Workbooks.Open("C:\jobtest\JobOrderMasterList.xlsm")
Worksheets("Quote").Select
Worksheets("Quote").Range("A1").Select
RowCount = Worksheets("Quote").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Quote").Range("A1")
.Offset(RowCount, 0) = CreationDate
.Offset(RowCount, 1) = JobOrder
.Offset(RowCount, 2) = CompanyName
.Offset(RowCount, 3) = Jobtype
.Offset(RowCount, 1).Activate
End With
ActiveCell.Hyperlinks.Add ActiveCell, strFolder
MasterList.Save
MasterList.Close
'call email from here
Call SendEmail
End Sub


Private Sub SendEmail()
Dim OutApp As Object
Dim OutMail As Object


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


On Error Resume Next
With OutMail
.to = "jgaiser@cwmenvironmental.com"
.CC = ""
.BCC = ""
.Subject = "T&M Field "
.Body = "Attached is the T&M for this particular project"
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[RCBricker]

I brought into the code anything that you just added above that I didn't have. Just go through the code and change sheet, range, and workbook variables so that they point to where you want them.

then see if it errors out. If it does, then we need to figure out what line is bugging and what error code you are getting.

Sub master()
'Updates Job Orders Masterlist
Dim CreationDate As Date
Dim JobOrder As String, CompanyName As String, Jobtype As String, _
    strFolder As String
Dim MasterList As Workbook, wbcode As Workbook
Dim rowcount As Long
Dim WsQuote As Worksheet, wsDest As Worksheet
Dim strNEWFN As String

    Set wbcode = ThisWorkbook
    Set WsQuote = wbcode.Sheets("Qoute")
    
    ' Next Quote Number
    WsQuotel.Range("J10").Value = WsQuote.Range("J10").Value + 1


 ' Next TM Number
    WsQuote.Range("J9").Value = WsQuote.Range("J9").Value + 1
    wsqoute.Copy
    strNEWFN = "C:\jobtest\Quote" & Range("J10").Value & ".xlsm"
    wbcode.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbookMacroEnabled

    'Current date
    Sheets("Quote").Range("H3"). _
    Value = Format(Now, "mm/dd/yy")
    
    CreationDate = WsQuote.Range("H3")
    JobOrder = WsQuote.Range("J10")
    CompanyName = WsQuote.Range("B3") 'First variable set to B3
    Jobtype = WsQuote.Range("B3")   'second variable set to B3
    
    strFolder = "C:\jobtest\Quote" & JobOrder & ".xlsm"
    
    Set MasterList = Workbooks.Open("C:\jobtest\JobOrderMasterList.xlsm")
    Set wsDest = MasterList.Sheets("Sheet1") 'change this to sheet in master the data is going into
    
     rowcount = wsDest.Range("A" & .Rows.Count).End(xlUp).Offset(1).Row
     With wsDest.Range("A" & rowcount)
        .Value = CreationDate
        .Offset(, 1).Value = JobOrder
        .Offset(, 2).Value = CompanyName
        .Offset(, 3).Value = Jobtype
     End With
     ActiveCell.Hyperlinks.Add wsDest.Range("A" & rowcount), strFolder
     MasterList.Save
     MasterList.Close
     
End Sub