help with a combobox and how it loads its list (its selections)

kbishop94 · Oct 19, 2022

so this is on a worksheet, and there are two comboboxes. one of them (the top one) loads its entries from a separate worksheet and within a named range that contains the selections. my problem/question does not pertain to this first box.

the second box, the box directly below the first one, grabs its selections directly from the worksheet that it is on and from a named range titled "Events". This all works fine right now with how it currently exists with no issues.

However, and ideally, I would like the second box's selections to grabbed after the items in the named range have been narrowed down by what was previously selected in the first box...

example:
Here is the worksheet before making any selections (and showing the named range "Events" that the 2nd combo box grabs its selections from):

As an example to explain what I am wanting the 2nd combobox to do, here is the worksheet before selecting the option for "tool box talk monthly training" from the FIRST combobox (the top one.) :

And then here is how it looks after making that particular selection and showing only the 'tool box talk' items and hiding all the other rows: (and the remaining rows is what I need to be populated in the SECOND combobox when it is selected...)

This is where my question/problem comes into play...
Here is the code for the second combobox... but what its doing is loading the selections when the worksheet is activated and from the named range "Events". What I need it to do instead is load the selections when the combobox is clicked (via the drop down button) and only grabbing the visible rows in the named range "Events". how exactly do I do that? Thanks

here is the code for both comboboxes that is executed when the worksheet is activated:

VBA Code:

'
Private Sub Worksheet_Activate()
'
Dim cTyp As Range
Dim TE As Worksheet
Set TE = Worksheets("LISTS")
For Each cTyp In TE.Range("TRAIN_TYPE")
    With Me.cboTraining
        .AddItem cTyp.value
    End With
Next cTyp
'
Dim cEve As Range
Dim EE As Worksheet
Set EE = Worksheets("Training Tracker")
For Each cEve In EE.Range("EVENTS")
    With Me.cboFN
        .AddItem cEve.value
    End With
Next cEve
'
End Sub

Next, here is my code for the FIRST combobox (the top one)... as I mentioned, this code works fine and no changes are needed:

(pls feel free just scroll down to the bottom if this post to read the code for the next combobox which is what my question concerns... I debated about even including the code for the first combobox in my post since my issue isn't with this first box... but since what I am requesting involves this first box, I decided to include it in my post.)

VBA Code:

'
Private Sub cboTraining_Change()
'
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False
'
ActiveWindow.ScrollColumn = 1
'
Dim rCol As Long
    rCol = Cells.Find("*", , , , xlByRows, xlPrevious, , , False).Row
Dim cCus As Range
Dim DataCriteria As String
'
' CHANGE ALL THE FONT COLORS OF THE NAMES IN THE DUPLICATE NAME COLUMN TO WHITE(to keep them invisible)
'For Each Cell In Range(Cells(1, 12), Cells(1, lCol))
'    If Cell.Column Mod 2 = 1 Then
'        Cell.Font.Color = &HFFFFFF
'    Else
'    End If
'Next Cell
'
If cboTraining.value = "Unsort Training Type List" Or cboTraining.value = "Select  a  Training  Type  to  view  ONLY  those  specific  types  of  Training  Events:" Then
    lblTR.BackColor = &H800000
    Else
    lblTR.BackColor = &HC000&
End If

' HIDE ALL THE DATE COLUMN AND ONLY LIST THE NAME COLUMNS
For Each Cell In Range(Cells(12, 2), Cells(rCol, 2))
If Cell = "" Then Columns(Cell.Row).Hidden = True Else Columns(Cell.Column).Hidden = False
Next
'
ActiveWindow.ScrollColumn = 1
Range("E3") = ""
'
' CODE BELOW THIS POINT DEALS THE SPECIFIC ACTIONS FOR THE BUTTON THAT WAS SELECTED:
'
'**********************************************************************
'**********************************************************************
'
If cboTraining.value = "Audit Training" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*AUDT*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Confined Spaces" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*CONS*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Customer Service Training" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*CUST*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "DHS Training" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*DHS*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "DOT Closure Training" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*DOT*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
'lblReset2.BackColor = &HC0FFC0
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "FDA Training" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*FDA*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Fire/Emergency Response" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*FIRE*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Fork Lift & Mobile Equipment" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*FORK*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
'lblReset2.BackColor = &H8080FF
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "GMP Awareness" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*GMP*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
'lblReset2.BackColor = 13382655
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "HAZMAT & UN Training" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*HAZ*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Labeling & Placards" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*LABP*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Laboratory Functions" Then
'
' SHOW ONLY THE EMPLOYEES CONNECTED TO THE DEPARTMENT THAT WAS CLICKED
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*TECH*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Lean 5S & Kaizen Events" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*LEAN*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
'lblReset2.BackColor = &HC0BFF7
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Monthly Safety Training" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*SAFE*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "OSHA or OSHA related" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*OSHA*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
'lblReset2.BackColor = &HFFFF&
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "PPE/Respirator" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*PPE*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
'lblReset2.BackColor = &H4D4D4D
'lblReset2.BorderStyle = 1
'lblReset2.BorderColor = &HC0FFC0
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Quality Management" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*QMS*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Railcar Tolling & Railcar Processes" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*RAIL*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Sales Training" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*SALE*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Slip, Trip & Falls" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*FALL*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Spills & Chemical Containment" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*SPIL*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Tool-Box Talk Monthly Training" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*TOOL*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Unsort Training Type List" Then
'
Columns.EntireRow.Hidden = False
'
Range("E3") = ""
'

Dim NCol As Long
NCol = Cells.Find("*", , , , xlByColumns, xlPrevious, , , False).Column


    rCol = ActiveSheet.UsedRange.Rows.Count
Dim MCol As Long
    MCol = Cells.Find("*", , , , xlByColumns, xlPrevious, , , False).Column
'
'
Dim eCnt As Long
Dim tCnt As Long
    tCnt = ActiveSheet.Range(Cells(1, 14), Cells(1, NCol)).SpecialCells(xlCellTypeVisible).Cells.Count
    'eCnt = ActiveSheet.Range(Cells(7, 1), Cells(qCol, 1)).Rows.Count / 2
    'tCnt = eCnt - 1
    lblCount.Caption = tCnt
    lblCount.ForeColor = &HFFFFFF
    lblCount.Font.Bold = True
    lblCountBASE1.BackColor = &H800000
'
lblTraining.Caption = "HIDING"
lblTraining.Font.Size = 9
lblTRAINING_1.Caption = "SHOW"
lblTRAINING_1.Font.Size = 9
'cmdUnhide2_5.Caption = "A"
'cmdShowCodes.Caption = "Show Codes"
'
' UNFORMAT ALL REMAINING FORMATTING TYPES IN BOTH THE COMMANDBUTTONS AND LABELS ON THE WORKSHEET:
'
lblTraining.Caption = "HIDING"
lblTraining.Font.Size = 9
lblTRAINING_1.Caption = "SHOW"
lblTRAINING_1.Font.Size = 9
'
Range(Cells(1, 1), Cells(9, NCol)).Interior.Color = xlNone
Range(Cells(12, 1), Cells(rCol, NCol)).Interior.Color = xlNone
'
Range(Cells(1, 1), Cells(9, NCol)).Font.Color = vbBlack
Range(Cells(12, 1), Cells(rCol, NCol)).Font.Color = vbBlack
'
Range(Cells(1, 1), Cells(9, NCol)).Font.Bold = False
Range(Cells(12, 1), Cells(rCol, NCol)).Font.Bold = False
'
Range(Cells(1, 1), Cells(9, NCol)).Font.Bold = False
Range(Cells(12, 1), Cells(rCol, NCol)).Font.Bold = False
'
Range(Cells(1, 1), Cells(rCol, NCol)).Borders.Color = vbBlack
Range(Cells(1, 1), Cells(rCol, NCol)).Borders.Weight = xlThin
'
With Columns("A:B")
    .ColumnWidth = 0.05
End With
With Columns("D")
    .ColumnWidth = 0.01
End With
With Columns("E")
    .ColumnWidth = 7.57
    .Font.Color = &H80&
End With
With Columns("F:M")
    .ColumnWidth = 0.01
End With
With Columns("C")
    .ColumnWidth = 78.14
End With
'
Range("E3") = ""
'
For Each Cell In Range(Cells(1, 12), Cells(1, MCol))
    If Cell.Column Mod 2 = 1 Then
       Cell.Font.Color = &HFFFFFF
    Else
    End If
Next Cell
'
For Each Cell In Range(Cells(4, 14), Cells(4, NCol))
'If Cell = "a" Then Columns(Cell.Column).Hidden = True Else Columns(Cell.Column).Hidden = False
If Cell = "b" Then Columns(Cell.Column).Hidden = True Else Columns(Cell.Column).Hidden = False
Next
'
For Each Cell In Range(Cells(10, 2), Cells(rCol, 2))
If Cell = "" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = False
Next
'
Application.CutCopyMode = False
'
ActiveSheet.Rows("2:4").Font.Name = "Lucida Sans Unicode"
ActiveSheet.Rows("2:4").Font.Size = 7
ActiveSheet.Rows("2:7").RowHeight = 0.5
ActiveSheet.Rows("8").RowHeight = 23.75
ActiveSheet.Rows("9").RowHeight = 0.75
'***********************************************************************************************************************************************
ActiveWindow.Zoom = 130
'
lblSH.Caption = "."
lblHH.Caption = "."
Range("E3") = ""
'lblReset2.BackColor = &H8000000F
'lblReset2.BorderStyle = None
'
cboTraining.value = "Unsort Training Type List"
'
With Columns("K:L")
    .ColumnWidth = 0.01
End With
'
On Error Resume Next
'
End If
'
'**********************************************************************
' END OF CODE FOR THE SELECTED NAMES; now code is for taking a tally of the names currently shown on the screen.
'**********************************************************************
'
' CALCULATE THE NUMBER OF EMPLOYEES SHOWN ON THE SCREEN AND CHANGE THE LABEL TO REFLECT THE #
'tCnt = ActiveSheet.Range(Cells(1, 14), Cells(1, lCol)).SpecialCells(xlCellTypeVisible).Cells.Count
'lblCount.Caption = tCnt
'lblCount.ForeColor = 5395158
'lblCountBase1.BorderColor = 5395158
'
With Columns("K:L")
    .ColumnWidth = 0.01
End With
'
Cells(1, 1).Select
'
ActiveWindow.ScrollColumn = 1
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

And lastly, here is my code for the SECOND combobox, which I am needing to modify so that instead of populating the list when the worksheet is first activated (like it does now) and with all the rows in the named range, I need it instead to grab only the VISIBLE rows within the named range and right at the time that the combobox is selected/clicked on.

I should also clarify that I cant have the second combobox to update/populate its list upon whenever a selection is made in the first combobox (dependent upon that selection) because there will be many cases where the first combobox isnt even selected at all. (hence why I need it to grab its list rows whenever its 'clicked'. this will ensure that either possibility- a selection is previously made with the first combobox, or, if the first combobox is ignored entirely and the user goes right to making a selection in only the second comboxbox. Thanks for any help/suggestions!

VBA Code:

'
Private Sub cboFN_Change()
'
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False
Range("E3") = ""
'
If cboFN.value = "Select  a  Training  Event  to  View  the  Participants:" Or cboFN.value = "Sort By:  Training Event" Then
    lblFN.BackColor = &H800000
    Else
    lblFN.BackColor = &HC000&
End If
'
Dim OCol As Long
    OCol = Cells.Find("*", , , , xlByRows, xlPrevious, , , False).Row
    QCol = ActiveSheet.UsedRange.Rows.Count
Dim PCol As Long
    PCol = Cells.Find("*", , , , xlByColumns, xlPrevious, , , False).Column
'
lblTraining.Caption = "HIDING"
lblTraining.Font.Size = 9
lblTRAINING_1.Caption = "SHOW"
lblTRAINING_1.Font.Size = 9
'
' UNFORMAT ALL REMAINING FORMATTING TYPES IN BOTH THE COMMANDBUTTONS AND LABELS ON THE WORKSHEET:
lblTraining.Caption = "HIDING"
lblTraining.Font.Size = 9
lblTRAINING_1.Caption = "SHOW"
lblTRAINING_1.Font.Size = 9
'
Range(Cells(1, 1), Cells(9, OCol)).Interior.Color = xlNone
Range(Cells(12, 1), Cells(QCol, OCol)).Interior.Color = xlNone
'
Range(Cells(1, 1), Cells(9, OCol)).Font.Color = vbBlack
Range(Cells(12, 1), Cells(QCol, OCol)).Font.Color = vbBlack
'
Range(Cells(1, 1), Cells(9, OCol)).Font.Bold = False
Range(Cells(12, 1), Cells(QCol, OCol)).Font.Bold = False
'
Range(Cells(1, 1), Cells(9, OCol)).Font.Bold = False
Range(Cells(12, 1), Cells(QCol, OCol)).Font.Bold = False
'
Range(Cells(1, 1), Cells(QCol, OCol)).Borders.Color = vbBlack
Range(Cells(1, 1), Cells(QCol, OCol)).Borders.Weight = xlThin
'
With Columns("A:B")
    .ColumnWidth = 0.05
End With
With Columns("D")
    .ColumnWidth = 0.01
End With
With Columns("E")
    .ColumnWidth = 7.57
    .Font.Color = &H80&
End With
With Columns("F:M")
    .ColumnWidth = 0.01
End With
With Columns("C")
    .ColumnWidth = 78.14
End With
'
Range("E3") = ""
'
For Each Cell In Range(Cells(1, 12), Cells(1, PCol))
    If Cell.Column Mod 2 = 1 Then
       Cell.Font.Color = &HFFFFFF
    Else
    End If
Next Cell
'
For Each Cell In Range(Cells(12, 3), Cells(QCol, 3))
If Cell Like cboFN.value Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
If Cell Like cboFN.value Then Range(Cells(Cell.Row, 1), Cells(Cell.Row, PCol)).Interior.Color = 6566400
If Cell Like cboFN.value Then Range(Cells(Cell.Row, 1), Cells(Cell.Row, PCol)).Font.Color = vbWhite
If Cell Like cboFN.value Then Range(Cells(Cell.Row, 1), Cells(Cell.Row, PCol)).Font.Bold = True
If Cell Like cboFN.value Then Range(Cells(Cell.Row, 1), Cells(Cell.Row, PCol)).Borders.Weight = xlThin
If Cell Like cboFN.value Then Range(Cells(Cell.Row, 1), Cells(Cell.Row, PCol)).Borders.Color = vbWhite
Next
'
If cboFN.value = "Select  a  Training  Event  to  View  the  Participants:" Then lblMissedAttendOVERLAY.Visible = True Else lblMissedAttendOVERLAY.Visible = False
If cboFN.value = "Select  a  Training  Event  to  View  the  Participants:" Then lblMissedOVERLAY.Visible = True Else lblMissedOVERLAY.Visible = False
If cboFN.value = "Select  a  Training  Event  to  View  the  Participants:" Then lblAttendOVERLAY.Visible = True Else lblAttendOVERLAY.Visible = False
'
On Error Resume Next
'
Dim eCnt As Long
Dim tCnt As Long
Dim kKol As Long
    kKol = Cells.Find("*", , , , xlByColumns, xlPrevious, , , False).Column
' CALCULATE THE NUMBER OF EMPLOYEES SHOWN ON THE SCREEN AND CHANGE THE LABEL TO REFLECT THE #
    tCnt = ActiveSheet.Range(Cells(1, 14), Cells(1, kKol)).SpecialCells(xlCellTypeVisible).Cells.Count
    lblCount.Caption = tCnt
    lblCount.ForeColor = &HFFFFFF
    lblCount.Font.Bold = True
    lblCountBASE1.BackColor = &H800000
'
Application.CutCopyMode = False
'
ActiveSheet.Rows("2:4").Font.Name = "Lucida Sans Unicode"
ActiveSheet.Rows("2:4").Font.Size = 7
ActiveSheet.Rows("2:7").RowHeight = 0.5
ActiveSheet.Rows("8").RowHeight = 23.75
ActiveSheet.Rows("9").RowHeight = 0.75
'***********************************************************************************************************************************************
ActiveWindow.Zoom = 130
'
lblSH.Caption = "."
lblHH.Caption = "."
Range("E3") = ""
'
If cboFN.value = "Select  a  Training  Event  to  View  the  Participants:" Then Columns.EntireRow.Hidden = False
'
With Columns("K:L")
    .ColumnWidth = 0.01
End With
'
On Error Resume Next
'
Dim wCnt As Long    'eCnt
Dim uCnt As Long    'tCnt
Dim jJol As Long    'kKol
    jJol = Cells.Find("*", , , , xlByColumns, xlPrevious, , , False).Column
' CALCULATE THE NUMBER OF EMPLOYEES SHOWN ON THE SCREEN AND CHANGE THE LABEL TO REFLECT THE #
    uCnt = ActiveSheet.Range(Cells(1, 14), Cells(1, jJol)).SpecialCells(xlCellTypeVisible).Cells.Count
    lblCount.Caption = uCnt
    lblCount.ForeColor = &HFFFFFF
    lblCount.Font.Bold = True
    lblCountBASE1.BackColor = &H800000
'
ActiveWindow.ScrollColumn = 1
'
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

Anthony47 · Oct 20, 2022

Currently you load both the comboboxes on entering the worksheet...

I understand that the first Combobox filters the EVENT list and you would like using only the visible events in your second combobox

So add the following macro in a standard module of your vba project

VBA Code:

Sub ReloadCB2()
Dim cEve As Range
Dim EE As Worksheet
'
Set EE = Worksheets("Training Tracker")
For Each cEve In EE.Range("EVENTS")
    If Not cEve.EntireRow.Hidden Then       '<<< Added IF
        With ???.cboFN                    '!! SEE Note in the text
            .AddItem cEve.Value
        End With
    End If                                  '<<<
Next cEve
'
End Sub

This is a copy of your current instruction with an added IF /EndIf
Note: since this code is in a standard vba module (not a Class one) you need to address the control with its full coordinates. If it is an activex then you will use With Sheets("NameOfTheSheet").cboFN

Then you need to call this Sub ReloadCB2 whenever you change Combobox1; I seem this modification should be enough:

VBA Code:

Private Sub cboTraining_Change()
'
Call ReloadCB2                              '<<< Call ReloadCB2
Application.DisplayAlerts = False
'
' your code continue

I didn't understand from your long message if there are other situations that should /could modify the visible EVENT list

Try

Anthony47 · Oct 20, 2022

Try and let's know the result...

kbishop94 · Oct 20, 2022

Anthony47 said:
Currently you load both the comboboxes on entering the worksheet...

I understand that the first Combobox filters the EVENT list and you would like using only the visible events in your second combobox

So add the following macro in a standard module of your vba project

VBA Code:

Sub ReloadCB2() Dim cEve As Range Dim EE As Worksheet ' Set EE = Worksheets("Training Tracker") For Each cEve In EE.Range("EVENTS") If Not cEve.EntireRow.Hidden Then '<<< Added IF With ???.cboFN '!! SEE Note in the text .AddItem cEve.Value End With End If '<<< Next cEve ' End Sub

This is a copy of your current instruction with an added IF /EndIf
Note: since this code is in a standard vba module (not a Class one) you need to address the control with its full coordinates. If it is an activex then you will use With Sheets("NameOfTheSheet").cboFN

Then you need to call this Sub ReloadCB2 whenever you change Combobox1; I seem this modification should be enough:

VBA Code:

Private Sub cboTraining_Change() ' Call ReloadCB2 '<<< Call ReloadCB2 Application.DisplayAlerts = False ' ' your code continue

I didn't understand from your long message if there are other situations that should /could modify the visible EVENT list

Try

Thank you for your reply and with the code that you created.

Its not quite working, though. Its double-populating it with all the rows twice... (circled in red) instead of only showing the "tool box talk" rows which was previously selected in the top combobox (cboTraining) that I selected to be used as an example:

I did think of something else too. I think its going to need an additional 'If' statement at the very beginning of the module code.

This new 'If' statement should look at what is currently selected in the first combobox (the cboTraining box) and if this box is showing the default selection, "Select a Training Type to view ONLY those specific types of Training Events:", then the code should populate cboFN (the bottom combobox) with all the rows within the named range "Events". This is because if nothing is selected in the first combobox, then what needs to be populated in the 2nd one (cboFN) should be all the rows. (you might of known that, but since you also said that you were somewhat confused at what I was describing, i thought I better clarify that...)

here are some additional pictures that should help explain, step by step what I am wanting it to do:

1. first, the worksheet showing all default values:

2. next, the selection 'Tool-Box Talk Monthly Training' is selected from the combobox cboTraining (the top combobox):
(red circle showing the tool-box talk selection and the blue circle showing what is about to remain hidden with the other rows in the named range being hidden):

3. making that selection returns this:

4. now, what I want to see at this point, is the bottom combobox (cboFN) populated with choices that represent only the 7 rows that were not hidden. But instead its populating it with double entries of all the rows (see pic above, the first one in this post.)

Thanks again for all your help on this. I really do appreciate it.

kbishop94 · Oct 20, 2022

Also, here is your code for how it appears in my VBA:
first code listed, is at the very top of the worksheet for the worksheet code: (I removed the 2nd part (greened it out) because that is how it used to be populate it before the module code that you provided.) (if I dont remove this, then it only adds additional copies of each row in the cboFN box.)

VBA Code:

'
[CODE=vba]Private Sub Worksheet_Activate()
'
Dim cTyp As Range
Dim TE As Worksheet
Set TE = Worksheets("LISTS")
For Each cTyp In TE.Range("TRAIN_TYPE")
    With Me.cboTraining
        .AddItem cTyp.value
    End With
Next cTyp

'Dim cEve As Range
'Dim EE As Worksheet
'Set EE = Worksheets("Training Tracker")
'For Each cEve In EE.Range("EVENTS")
'    With Me.cboFN
'        .AddItem cEve.value
'    End With
'Next cEve
'
'End Sub

Then for the combobox cboTraining (only showing down to the first two selections for the code as the rest is redundant)

VBA Code:

'
Private Sub cboTraining_Change()
'
' RUN THE MODULE THAT WILL POPULATE THE COMBOBOX WITH THE SELECTIONS:
Call ReloadCB2
'
Application.DisplayAlerts = Fals
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False
'
ActiveWindow.ScrollColumn = 1
'
Dim rCol As Long
    rCol = Cells.Find("*", , , , xlByRows, xlPrevious, , , False).Row
Dim cCus As Range
Dim DataCriteria As String
'
If cboTraining.value = "Unsort Training Type List" Or cboTraining.value = "Select  a  Training  Type  to  view  ONLY  those  specific  types  of  Training  Events:" Then
    lblTR.BackColor = &H800000
    Else
    lblTR.BackColor = &HC000&
End If

' FIRST HIDE ALL THE DATE COLUMNS THAT MAY BE VISIBLE AND ONLY SHOW THE COLUMNS THAT CONTAIN THE EMPLOYEE'S NAME:
For Each Cell In Range(Cells(12, 2), Cells(rCol, 2))
If Cell = "" Then Columns(Cell.Row).Hidden = True Else Columns(Cell.Column).Hidden = False
Next
'
ActiveWindow.ScrollColumn = 1
Range("E3") = ""
'
' CODE BELOW THIS POINT WILL UNHIDE ONLY THE SPECIFIC TYPE OF TRAINING TYPE THAT WAS SELECTED:
'
'**********************************************************************
'**********************************************************************
'
If cboTraining.value = "Audit Training" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*AUDT*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************
If cboTraining.value = "Confined Spaces" Then
'
For Each Cell In Range(Cells(12, 1), Cells(rCol, 1))
If Cell Like "*CONS*" Then Rows(Cell.Row).Hidden = False Else Rows(Cell.Row).Hidden = True
Next
'
Range("E3") = "i"
Range("E3") = ""
'
On Error Resume Next
'
End If
'**********************************************************************
'**********************************************************************

And the module code:

VBA Code:

Sub ReloadCB2()
Dim cEve As Range
Dim EE As Worksheet
'
Set EE = Worksheets("Training Tracker")
For Each cEve In EE.Range("EVENTS")
    If Not cEve.EntireRow.Hidden Then       '<<< Added IF
        With Sheets("Training Tracker").cboFN                    '!! SEE Note in the text
            .AddItem cEve.value
        End With
    End If                                  '<<<
Next cEve
'
End Sub

Anthony47 · Oct 20, 2022

Restore the original Private Sub Worksheet_Activate, so that both Comboboxes can be initially populated

BUT Sub ReloadCB2 need to clear the previous cbo setting; thus

VBA Code:

Sub ReloadCB2()
Dim cEve As Range
Dim EE As Worksheet
'
Do While Sheets("Sheet1").cboFN.ListCount > 0     'Clear contents...
    Sheets("Sheet1").cboFN.RemoveItem (0)
Loop
'
'...then Reload:
Set EE = Sheets("Sheet1")
For Each cEve In EE.Range("A1:A30")
    If Not cEve.EntireRow.Hidden Then       '<<< Added IF
        With Sheets("Sheet1").cboFN                    '!! SEE Note in the text
            .AddItem cEve.Value
        End With
    End If                                  '<<<
Next cEve
'
End Sub

Beware: I used my sheet name; adapt for your environment

As per the other part of your message, the situation is for me quite confused, cannot follow you without a real test workbook; so if you can share one maybe I could do something more

kbishop94 · Oct 23, 2022

Anthony47 said:
Restore the original Private Sub Worksheet_Activate, so that both Comboboxes can be initially populated

BUT Sub ReloadCB2 need to clear the previous cbo setting; thus

VBA Code:

Sub ReloadCB2() Dim cEve As Range Dim EE As Worksheet ' Do While Sheets("Sheet1").cboFN.ListCount > 0 'Clear contents... Sheets("Sheet1").cboFN.RemoveItem (0) Loop ' '...then Reload: Set EE = Sheets("Sheet1") For Each cEve In EE.Range("A1:A30") If Not cEve.EntireRow.Hidden Then '<<< Added IF With Sheets("Sheet1").cboFN '!! SEE Note in the text .AddItem cEve.Value End With End If '<<< Next cEve ' End Sub

Beware: I used my sheet name; adapt for your environment

As per the other part of your message, the situation is for me quite confused, cannot follow you without a real test workbook; so if you can share one maybe I could do something more

Thanks for all your help (again)

I attached a sample of the workbook with the worksheet module that I need the help with (what you have been helping me with.) take a look at it whenever you get the time and let me know if you have any questions for me. thank you. its been a while since I shared a workbook on here... (a couple of years at least) how do I do that again?

kbishop94 · Oct 23, 2022

ok.. so it was FOUR years ago that I last shared a workbook on here haha

I shared it via my drop box so thats what I did here as well. Thanks and let me know if you have any questions (I set the file properties on the dropbox options to 'edit' for you.)

Training Matrix (64b) (demo).xlsm

Anthony47 · Oct 24, 2022

First of all, Sub ReloadCB2 has to be called, obviously, at the END of cboTraining_Change, when the cboTraining_Change macro has completed its setting; obviously

Thus:

VBA Code:

Private Sub cboTraining_Change()
'
'
'all your code
'
Application.EnableEvents = True
'
Call ReloadCB2           '<<< ReloadCB2 called HERE
End Sub

I tryied looking into the code, however (forgive me) it looks quite unreadable:
missing indentation, meaningless lines (eg If cell = "" Then Rows(cell.Row).Hidden = False Else Rows(cell.Row).Hidden = False, or Range("E3") = "i" /Range("E3") = ""), repeated cicles (eg With Columns("K:L") / .ColumnWidth = 0.01 /End With), a series of On Error Resume Next

So I was not able to find the global organization of the code.

However I realized that the setting of cboFN via Sub ReloadCB2 created a loop with cboFN_Change; therefore I added a flag on top of the module

Code:

Dim ChangeBusy As Boolean    'on top of the module!

Then and added some instructions to use it; namely:
1) In cboFN_Change:

Code:

Private Sub cboFN_Change()
'
' RUN THE MODULE THAT WILL POPULATE THE COMBOBOX WITH THE SELECTIONS:
'Call ReloadCB2
'
If ChangeBusy Then Exit Sub               '<<< ADDED
Application.DisplayAlerts = False
'etc etc

2) In cboTraining_Change

Code:

Private Sub cboTraining_Change()
Debug.Print "Enter cboTraining Change", Timer
'
' RUN THE MODULE THAT WILL POPULATE THE COMBOBOX WITH THE SELECTIONS:
'Call ReloadCB2
'
ChangeBusy = True          '<<< Set the added flag
Application.DisplayAlerts = False
'
'
' your original code here
'
'
Application.EnableEvents = True
'
Call ReloadCB2            '<<< ReloadCB2 called HERE
ChangeBusy = False        '<<< Clear the added flag
End Sub

This prevents that cboFN reloading modify on-the-fly the content of the EVENTS range.

With these modifications I went to a reasonable behaviour of the comboboxes

As a suggestion to make cboTrainingChange simpler:
-you have a lot of phases where you check cboTraining value and hide /unhide rows according a condition; for example:

Code:

If cboTraining.value = "Audit Training" Then
    '
    For Each cell In Range(Cells(15, 1), Cells(rCol, 1))
    '    Debug.Print cell.value
        If cell Like "*AUDT*" Then Rows(cell.Row).Hidden = False Else Rows(cell.Row).Hidden = True
    Next
    '
    Range("E3") = "i"          'WHAT'S FOR?
    Range("E3") = ""           
    '
    On Error Resume Next       'WHY? Repeat WHY?
'
End If

(INDENTATION FOR READABILITY AND COMMENTS have been added by me)

My suggestion is that you review the content of sheets LIST and add, near each "Training Kind" the keyword that marks (in sheet Training Tracker col. A) that type of training.
So for example in C15, near the category HAZMAT & UN Training, you insert HAZ; in C9, near the category DOT Closure Training, you insert DOT; and so on for all the categories.

Then, rather then several If cboTraining.value = "This" Then /Do That End If, you will be able to use a single

Code:

Dim lKey As Variant

lKey = Application.VLookup(Object4.cboTraining.value, Sheets("LISTS").Range("TRAIN_TYPE").Resize(, 2), 2, 0)
If Not IsError(lKey) Then
    For Each cell In Range(Cells(15, 1), Cells(rCol, 1))
        If cell Like "*" & lKey & "*" Then Rows(cell.Row).Hidden = False Else Rows(cell.Row).Hidden = True
    Next
    '
    Range("E3") = ""
    '
    'On Error Resume Next       'Re-enable if necessary
End If

Also, if there are operations that you need to execute in several positions, then bring the code that do that in a specific Sub ThatTask and call that sub when you need the task done.

Hope you can find some useful insights...

Anthony47 · Oct 24, 2022

I also found that HAZMAT & UN Training is typed in sheet LIST with a final "space", so If cboTraining.value = "HAZMAT & UN Training" Then will always fail

help with a combobox and how it loads its list (its selections)

kbishop94

Active Member

Attachments

Excel Facts

Anthony47

Well-known Member

Anthony47

Well-known Member

kbishop94

Active Member

kbishop94

Active Member

Anthony47

Well-known Member

kbishop94

Active Member

kbishop94

Active Member

Anthony47

Well-known Member

Anthony47

Well-known Member

Similar threads

Forum statistics

Share this page

help with a combobox and how it loads its list (its selections)

Active Member

Attachments

Excel Facts

Well-known Member

Well-known Member

Active Member

Active Member

Well-known Member

Active Member

Active Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock