I am making a form to help help amplify our quoting times. I have successfully made dependent comboboxs but I want to take it a step further
combo box 1 - selects category
combobox 2 - uses advanced filter to sort parts by selected category (displays part number and description which are 2 separate column's)
would like to fill all the other textbox based on the part selected as they are unique to that part number.
I then take this data and will load it into the corresponding worksheet which this option already works also.
my issue is I can not get the textbox to fill based on other columns in that are associated to the part number selected. I have been trying several things the last couple days with zero luck
any help is appreciated here is my current code and attached is the project
'Combobox Dependancies
Private Sub cboPartType_AfterUpdate()
On Error Resume Next
Dim ws As Worksheet
Dim rngCrit As Range
Dim rngExt As Range
Dim strList As String
Dim strTable As String
Dim LstExt As ListObject
Set ws = Worksheets("LookupLists")
Set rngCrit = ws.Range("CritPartCat")
Set rngExt = ws.Range("ExtPartDesc")
strList = "PartSelList"
strTable = "tblExtract"
Me.cboPart.Value = ""
'check for a valid part type
If cboPartType.ListIndex >= 0 Then
With ws
rngCrit.Cells(2, 1).Value _
= Me.cboPartType.Value
.Range("PartsLookup").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCrit, _
CopyToRange:=rngExt, _
Unique:=False
'change extract table to range
.ListObjects(strTable).Unlist
.Columns("N:Q").Style = "Normal"
'create new extract table
Set LstExt = .ListObjects.Add(xlSrcRange, _
rngExt.CurrentRegion, , xlYes)
LstExt.Name = strTable
'redefine the named range
ActiveWorkbook.Names(strList).RefersToR1C1 = "=" & strTable
End With
Me.cboPart.RowSource = strList
Else
'no Part list if valid part type is not selected
Me.cboPart.RowSource = ""
End If
End Sub
'Add Part to list
Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lPartType As Long
Dim lPart As Long
Dim lLoc As Long
Dim ws As Worksheet
Set ws = Worksheets("PartsData")
'find first empty row in database
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
lPartType = Me.cboPartType.ListIndex
lPart = Me.cboPart.ListIndex
lLoc = Me.cboLoc.ListIndex
'check for a valid part type
If lPartType = -1 Then
Me.cboPartType.SetFocus
MsgBox "Please enter a valid part type"
Exit Sub
End If
'check for a valid part number
If lPart = -1 Then
Me.cboPart.SetFocus
MsgBox "Please enter a valid part number"
Exit Sub
End If
'check for a valid location
If lLoc = -1 Then
Me.cboLoc.SetFocus
MsgBox "Please enter a valid location"
Exit Sub
End If
'copy the data to the database
With ws
.Cells(lRow, 1).Value = Me.cboPart.Value
.Cells(lRow, 2).Value = Me.cboPartType.Value
.Cells(lRow, 3).Value = Me.cboPart.List(lPart, 1)
.Cells(lRow, 4).Value = Me.cboLoc.Value
.Cells(lRow, 6).Value = Me.txtQty.Value
End With
'clear the data
Me.cboPartType.Value = ""
Me.cboPart.Value = ""
Me.cboPart.RowSource = ""
Me.cboLoc.Value = ""
'enter the default values
Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtQty.Value = 1
Me.cboPartType.SetFocus
End Sub
'Close form
Private Sub cmdClose_Click()
Unload Me
End Sub
'set the default values
Private Sub UserForm_Initialize()
Me.txtQty.Value = 1
Me.cboPart.RowSource = "" 'no parts list
Me.cboPartType.SetFocus
End Sub
Display More