Thanks fort getting back to me i really appreciate your time.
I'm new to VBA and don't have much experience.
Could you look at my code and tell me where I should insert the code you provided.
I could also email you my file if that would help.
Thanks again for you time!
Dim Mode As Integer
Private Sub cboTool_Change()
On Error Resume Next
myImg = Me.cboTool.List(Me.cboTool.ListIndex, 2)
Me.Image1.Picture = LoadPicture(myImg)
End Sub
Private Sub cboProduct_AfterUpdate()
On Error Resume Next
Dim ws As Worksheet
Dim cPart As Range
Set ws = Worksheets("LookupLists")
Me.cboTool.Value = ""
Me.cboTool.RowSource = ""
With ws
.Range("CritPartCat").Cells(2, 1).Value _
= Me.cboProduct.Value
.Columns("A:D").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=.Range("CritPartCat"), _
CopyToRange:=.Range("ExtPartDesc"), _
Unique:=False
End With
'redefine the static named range
ThisWorkbook.Names.Add Name:="PartSelList", _
RefersTo:="=" & ws.Name & "!" & _
ws.Range("PartSelCatList").Address
Me.cboTool.RowSource = "PartSelCatList"
End Sub
Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'revised code to avoid problems with
'Excel lists and tables in newer versions
'find first empty row in database
''lRow = ws.Cells(Rows.Count, 1) _
'' .End(xlUp).Offset(1, 0).Row
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
lPart = Me.cboTool.ListIndex
If cboOperator.ListIndex = -1 Then
Cancel = 1
MsgBox "Operator Not Selected"
cboOperator.SetFocus
Exit Sub
End If
'check for a part number
If Trim(Me.cboTool.Value) = "" Then
Me.cboTool.SetFocus
MsgBox "Product Not Selected"
Exit Sub
End If
If cboMachine.ListIndex = -1 Then
Cancel = 1
MsgBox "Machine Not Selected"
cboMachine.SetFocus
Exit Sub
End If
If cboTool.ListIndex = -1 Then
Cancel = 1
MsgBox "Tool Not Selected"
cboTool.SetFocus
Exit Sub
End If
If cboReason.ListIndex = -1 Then
Cancel = 1
MsgBox "Reason Not Selected"
cboReason.SetFocus
Exit Sub
End If
If txtLife = "" Then
Me.txtLife.SetFocus
MsgBox "Tool Life Not Entered"
Exit Sub
End If
'copy the data to the database
With ws
.Cells(lRow, 1).Value = Me.cboTool.Value
.Cells(lRow, 2).Value = Me.cboProduct.Value
.Cells(lRow, 3).Value = Me.cboTool.List(lPart, 1)
.Cells(lRow, 4).Value = Me.cboMachine.Value
.Cells(lRow, 5).Value = Me.cboReason.Value
.Cells(lRow, 6).Value = Me.cboOperator.Value
.Cells(lRow, 7).Value = Me.txtDate.Value
.Cells(lRow, 8).Value = Me.txtTime.Value
.Cells(lRow, 9).Value = Me.txtLife.Value
End With
'clear the data
'ClearParts
Me.cboProduct.Value = ""
Me.cboReason.Value = ""
Me.cboOperator.Value = ""
Me.txtLife.Value = ""
Me.cboTool.Value = ""
Me.cboTool.RowSource = ""
Me.Image1.Picture = LoadPicture("")
Me.cboMachine.Value = ""
Me.txtDate.Value = Date
Me.txtTime.Value = Time()
Me.cboProduct.SetFocus
ThisWorkbook.Save
Unload Me
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdReset_Click()
Dim iControl As control
For Each iControl In Me.Controls
If iControl.Name Like "cbo*" Then iControl = vbNullString
If iControl.Name Like "txtLife*" Then iControl = vbNullString
Next
Set ws = Worksheets("LookupLists")
With ws
.Range("CritPartCat").Cells(2, 1).ClearContents
.Range("PartSelList").ClearContents
End With
End Sub
Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
End Sub
Private Sub UserForm_Initialize()
Dim cType As Range
Dim cPart As Range
Dim cLoc As Range
Dim ws As Worksheet
Set ws = Worksheets("LookupLists")
With ws
.Range("CritPartCat").Cells(2, 1).ClearContents
.Range("PartSelList").ClearContents
End With
For Each cType In ws.Range("PartCatList")
With Me.cboProduct
.AddItem cType.Value
End With
Next cType
For Each cLoc In ws.Range("MachineList")
With Me.cboMachine
.AddItem cLoc.Value
End With
Next cLoc
Me.cboTool.RowSource = ""
Me.txtDate.Value = Date
Me.txtTime.Value = Time()
Me.cboProduct.SetFocus
End Sub