When i run my userform it comes up with
Defined Name Lists.xls is already open. Reopening will cause any changes you made to be discarded. Do you want to reopen the Defined Name Lists.xls
If I click yes it comes up with the following error Run-time error.13 Type mismatch
If I click no it comes up with the following error Method open of Object Workbooks failed
Option Explicit
Const cListFile As String = "Defined Name Lists.xls" ' the file containing the combobox data
Const cListSheet As String = "JobName" ' the worksheet containing the list
Const cJobNameColumn As String = "A" ' the column containing the job name
Const cJobNoColumn As String = "B" ' the column containing the job number
Const cHasHeader As Boolean = True ' does the list have a header in row 1
Dim JobNames() As String ' array to hold the job name
Dim JobNos() As Single ' array to hold the job no
Private Sub cboJobName_Click()
' get the index of the item selected in the combobox
Dim theIndex As Long
theIndex = Me.cboJobName.ListIndex + 1
' update the job number
Me.txtJobNo.Value = JobNos(theIndex)
' Dim rw As Long
' With Worksheets("JobName")
' rw = .Range("$A2:$A50").Find(Me.cboJobName.Text, LookIn:=xlValues, _
' lookat:=xlWhole, MatchCase:=False).Row
' Me.txtJobName.Text = .Range("A" & rw).Value
' Me.txtJobNo.Text = .Range("B" & rw).Value
' End With
End Sub
Private Sub UserForm_Initialize()
' open the workbook containing the data to load in combox1 read only
' and hide it
Dim theWB As Workbook
Set theWB = Workbooks.Open(Filename:="Defined Name Lists.xls", ReadOnly:=True)
theWB.Windows(1).Visible = False
' address the combox list
Dim theSheet As Worksheet
Set theSheet = theWB.Worksheets(cListSheet)
' array size counter
Dim nList As Long
nList = 0
' loop through all of the list loading the values into the combobox
Dim rw As Range
For Each rw In theSheet.Rows
' skip row 1 if there is a header
If (rw.Row = 1 And cHasHeader) Then
' stop on the first blank cell
ElseIf (rw.Cells(1, 1).Value = "") Then
Exit For
Else
' move the data from the list workbook to the combox
cboJobName.AddItem rw.Cells(1, cJobNameColumn).Value
' update the job name and job number text boxes
Me.txtJobNo.Value = JobNos("")
' retain the job name and job nos
nList = nList + 1
ReDim Preserve JobNames(1 To nList)
ReDim Preserve JobNos(1 To nList)
JobNames(nList) = rw.Cells(1, cJobNameColumn).Value
JobNos(nList) = rw.Cells(1, cJobNoColumn).Value
End If
Next rw
' close the workbook and release storage
theWB.Close SaveChanges:=False
Set theWB = Nothing
Set theSheet = Nothing
End Sub
Private Sub CommandButton14_Click()
Dim mydir As String
mydir = "C:\Users\User\Documents"
If Dir(mydir & "\" & txtJobNo.Value & ".xls") <> "" Then
Workbooks.Open Filename:=mydir & "\" & txtJobNo.Value & ".xls"
Unload Me
Else
MsgBox "File: " & txtJobNo.Value & "Job Number Not Found"
End If
End Sub
Private Sub CommandButton13_Click()
frmAddJobName.Show
End Sub
Bookmarks