I'm really new to VBA. Below is the code that downloaded with the excel file. What I'm looking to add to the user form is to be able to display an image of the corresponding part that has been filtered from column "D" into column "O" LookUpLists sheet from the Part ID combo box and display it in the Image1 frame.
I'd also like to clear the image if the reset form button is executed like the rest of the form does with the other fields.
When the form is initialized it clears columns "M" and "N" and not "O" column
I noticed when I edited the defined names PartSelList to include "O" column that once the form is executed it defaults to the original setting of column "M" and "N"
Code:
Thank You for any help!
I'd also like to clear the image if the reset form button is executed like the rest of the form does with the other fields.
When the form is initialized it clears columns "M" and "N" and not "O" column
I noticed when I edited the defined names PartSelList to include "O" column that once the form is executed it defaults to the original setting of column "M" and "N"
Code:
Code:
Option Explicit
Private Sub cboType_AfterUpdate()
On Error Resume Next
Dim ws As Worksheet
Dim cPart As Range
Set ws = Worksheets("LookupLists")
Me.cboPart.Value = ""
Me.cboPart.RowSource = ""
With ws
.Range("CritPartCat").Cells(2, 1).Value _
= Me.cboType.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.cboPart.RowSource = "PartSelCatList"
End Sub
Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
Set ws = Worksheets("PartsData")
'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.cboPart.ListIndex
'check for a part number
If Trim(Me.cboPart.Value) = "" Then
Me.cboPart.SetFocus
MsgBox "Please enter a part number"
Exit Sub
End If
'copy the data to the database
With ws
.Cells(lRow, 1).Value = Me.cboPart.Value
.Cells(lRow, 2).Value = Me.cboType.Value
.Cells(lRow, 3).Value = Me.cboPart.List(lPart, 1)
.Cells(lRow, 4).Value = Me.cboLocation.Value
.Cells(lRow, 5).Value = Me.txtDate.Value
.Cells(lRow, 6).Value = Me.txtQty.Value
End With
'clear the data
'ClearParts
Me.cboType.Value = ""
Me.cboPart.Value = ""
Me.cboPart.RowSource = ""
Me.cboLocation.Value = ""
Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtQty.Value = 1
Me.cboType.SetFocus
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 "txtQty*" Then iControl = vbNullString
Next
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.cboType
.AddItem cType.Value
End With
Next cType
For Each cLoc In ws.Range("LocationList")
With Me.cboLocation
.AddItem cLoc.Value
End With
Next cLoc
Me.cboPart.RowSource = ""
Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtQty.Value = 1
Me.cboType.SetFocus
End Sub
Thank You for any help!
Last edited by a moderator: