Selected Answer
Hi again Divinedar
Revised Answer 11 Feb 2023
The reason your listbox was not populating is that my original answer populated them only with pre-checked items on the "PT-" sheets (at your request I believe)- if nothing is ticked, the list will be empty. That's started with the bold bits in this :
Private Sub cmbGunSel_Change()
<< omitted code>>
' with chosen source
With ThisWorkbook.Worksheets(Root & Me.cmbGunSel.Value)
' populate first list box with checked items only
For Each CT In .Shapes
If InStr(CT.Name, "Check Box") = 1 And CT.OLEFormat.Object.Value = 1 Then
<< omitted code>>
To demonstrate this, in the first revised attached file I've checked some items on sheet "PT-Colt_Gov_Model_MK_IV_80", added your frmForm and other modules. Now if you click the button "ENTER/EDIT..." on the Main Database sheet, pick a Customer No. on the first form and click pale green button Select Products..., the second form will display. Select Colt_Gov_Model_MK_IV_80 from the dropdown ComboBox and the checked items on that sheet will be listed.
If however you want all items to be listed (and check them in your form), the second file below (Online-Teach-Excel-Help-File listing all items v0_c.xlsm) does that. The (full) code has just the minor chnages in bold below:
Private Sub cmbGunSel_Change()
Dim Index As Long, Col As Long, Val As Variant, CT As Object
' do nothing if no model was picked
If Me.cmbGunSel.Value = "" Then Exit Sub
' clear previous list
Me.lstSELpart.Clear '1st listbox to fill
'do nothing if an invalid name was typed in
On Error Resume Next
If ThisWorkbook.Worksheets(Root & Me.cmbGunSel.Value).Name <> Root & Me.cmbGunSel.Value Then Exit Sub
' with chosen source
With ThisWorkbook.Worksheets(Root & Me.cmbGunSel.Value)
' populate first list box with ALL checkbox items
For Each CT In .Shapes
If InStr(CT.Name, "Check Box") = 1 Then ' And CT.OLEFormat.Object.Value = 1 Then
' populate columns of lstGunOrder
Me.lstSELpart.AddItem .Range(CT.TopLeftCell.Address).Offset(0, 1).Text
Index = 1
' loop through columns of checked item
For Col = 2 To 4
Val = .Range(CT.TopLeftCell.Address).Offset(0, Col).Value
' format the currency column
If Col = 4 Then Val = Format(Val, "$#,##0.00")
Me.lstSELpart.List(Me.lstSELpart.ListCount - 1, Index) = Val
' increase the column index
Index = Index + 1
Next Col
End If
Next CT
' set up LB2 columns
Me.lstSELpart.ColumnCount = 4
Me.lstSELpart.ColumnWidths = "40;200;40;40"
End With
End Sub
Now you'll get a list of all parts for whatever item you choose.
Note: After a comment from you, I should point out that the checkboxes are in a Collection- the order they are added to the list is determined by their name/position in the Collection (not by their positions on the sheet. This means the 001 item will alswatys appear first etc. To show this, on the second and third "PT-" sheets, I sorted the item names in column C- now you will notice that the items appear in the same number order but with the "correct" item name. Now, when you change the model, the list will change.
I noticed that your ListBox lstSELpart has a label note saying "This will fill from the gun list worksheet and only select one part item at a time ..." so I set the MultiSelect property to 0 - fmMultiSelectSingle (and you get radio buttons against items).
Also I noticed that the Customer Number was not coming over from the first form so restored the line in bold (for the second form):
Private Sub UserForm_Initialize()
Dim ws As Worksheet, CT As Shape
'populate Customer No.
frmGunParts.txtCustupdate.Text = frmForm.cboCustNo.Text
<<existing code>>
Revision 13 February 2023
Given I'm not clear which way you are going with your lists, I've added a third file below which:
- creates lists based on how they appear on the "PT-" sheets
- allow the user to choose to list all items or only those checked for the item.
The latter is done using a new checkbox (named "CB_lstSELpart" and shown as "List only checked items" above the listbox on the second form. When then is clciked (to change state): if just acts as if the model had changed:
Private Sub OptlstSELpart_Click()
Call cmbGunSel_Change
End Sub()
Call cmbGunSel_Change
End Sub
where that code is below and checks the state of that option button (with some significant changes shown in bold):
Private Sub cmbGunSel_Change()
Dim Index As Long, Col As Long, Val As Variant, CT As Object
Dim lRw As Long, Rw As Long
' do nothing if no model was picked
If Me.cmbGunSel.Value = "" Then Exit Sub
' clear previous list
Me.lstSELpart.Clear
'do nothing if an invalid name was typed in
On Error Resume Next
If ThisWorkbook.Worksheets(Root & Me.cmbGunSel.Value).Name <> Root & Me.cmbGunSel.Value Then Exit Sub
' with chosen source
With ThisWorkbook.Worksheets(Root & Me.cmbGunSel.Value)
'determine last used row in B
lRw = .Cells(.Rows.Count, 2).End(xlUp).Row
' loop down rows
For Rw = 3 To lRw
If IsEmpty(.Cells(Rw, 2)) = False Then
Index = 0
With .Cells(Rw, 1)
' populate the list based on the option
If CB_lstSELpart.Value = False Then
' add an item to the lstGunOrder list
Me.lstSELpart.AddItem .Offset(0, 1).Text
Index = 1
Else
' loop through shapes to see if a checked one in on column A or the row
For Each CT In .Parent.Shapes
' find if there's a checked box in this cell
If Not Intersect(.Range(CT.TopLeftCell.Address), .Cells(Rw, 1)) Is Nothing _
And InStr(CT.Name, "Check Box") = 1 _
And CT.OLEFormat.Object.Value = 1 _
Then
' if checked add an item to the lstGunOrder list
Debug.Print CT.TopLeftCell.Address
Me.lstSELpart.AddItem .Offset(0, 1).Text
Index = 1
End If
Next CT
End If
' only if an item was added, populate first four columns of list
If Index = 1 Then
' loop through next 3 columns and add to liost row
For Col = 2 To 4
Val = .Offset(0, Col).Value
' format the currency column
If Col = 4 Then Val = Format(Val, "$#,##0.00")
'add to column
Me.lstSELpart.List(Me.lstSELpart.ListCount - 1, Index) = Val
' increase the column index
Index = Index + 1
Next Col
End If
End With
End If
Next Rw
End With
' set up LB2 columns
Me.lstSELpart.ColumnCount = 4
Me.lstSELpart.ColumnWidths = "40;200;40;40"
End Sub
Note that it still polulates the list with values from columns B,C, D and E (even though the latter two aren't populated on your sheets and E might not hold a currency)
Hope this fixes things for you and gives you a good start to transferring the selections to other sheets or whatever.
