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

K

kbishop94

Active Member
Joined
Dec 5, 2016
Messages
476
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
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):
named_range.JPG

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.) :
$-before.jpg

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...)
$-after.jpg

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
 

Attachments

  • named_range-after-2.JPG
    named_range-after-2.JPG
    172.1 KB · Views: 9
  • named_range-after-1.JPG
    named_range-after-1.JPG
    161.2 KB · Views: 14
Last edited:
Sort by date Sort by votes
And finally I realized something you tried to get my attention on: before re-setting comboboxes listing using .AddItem we need to clear its current listing.
This requires for sure replacing your current Sub Worksheet_Activate code with the following:
VBA Code: 
Private Sub Worksheet_Activate()
'
Dim cTyp As Range
Dim TE As Worksheet
Set TE = Worksheets("LISTS")
Application.EnableEvents = False
'Clear cboTraining:
Do While Me.cboTraining.ListCount > 0     'Clear contents...
    Me.cboTraining.RemoveItem (0)
Loop
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")
'Clear cboFN:
Do While Me.cboFN.ListCount > 0     'Clear contents...
    Me.cboFN.RemoveItem (0)
Loop
For Each cEve In EE.Range("EVENTS")
    With Me.cboFN
        .AddItem cEve.value
    End With
Next cEve
'
Application.EnableEvents = True
End Sub
 
Upvote 0

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Anthony47 said:
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 :biggrin:
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...
Click to expand...

At the time I didn't think it was necessary to go into greater detail (and possibly make my post even more confusing/harder to follow...), but now I see that maybe I should of (which would of at the least provided some context and the purpose for what and why I was trying to do what I am doing.

Hopefully this might make it alittle more understandable for not only each row/columns purpose in the worksheet but also hopefully why the code is the way it is:

Here is the userform for how a new row that represents a single training event gets added to the worksheet.
The many blank checkboxes get populated with all the names in row 1 of the worksheet that are showing (not hidden) at the time when the 'add new training event' userform is opened. (any remaining 'empty' checkboxes that don't get populated with a name get hidden)
Below the userform pic is a screenshot pic of the worksheet showing where each userform field gets inserted into. Combobox 'cboTraining' (the top one) finds its match by comparing whatever might of been selected with its corresponding 'code' which gets entered into column A)
userform__explanation.jpg
column_explanation.jpg

The reason for the many and multiple mentions of cell "E3" throughout the code is for resetting any conditional fomatting that might of previously been applied based on some previous action within the module:
E3.JPG


Thank you again for taking all the time and effort that you did with creating and trying the new code that you came up with. (y)(y)(y)
 
Upvote 0
Anthony47 said:
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
Click to expand...
Wow, if nothing else, you probably just saved me a TON of time sometime in the future whenever I realized that the "HAZMAT & UN Training" selection wasnt working lol Thanks a million for finding that!! 🤦‍♂️)
 
Upvote 0
To avoid misunderstandigs...
The question was:
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...
Click to expand...

Now I seem that my messages #9, #10 and #11 suggest how to obtain that.

If I am wrong, please explain and I'll try at my best; if you wish receiving contibutes in different areas, probably it would be better if you open a new thread that will get attention from many experts
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Help needed with simple macro
2
Replies
15
Views
229
MARK858
MARK858
N
  • Question Question
Hiding/showing rows between two values
Replies
1
Views
479
Joe4
Joe4
Livin404
  • Solved
Adjust MACRO to only select non-consecutive columns.
Replies
6
Views
247
Alex Blakenburg
A
J
  • Question Question
VBA to send multiple emails with multiple attachments
Replies
5
Views
756
6StringJazzer
6StringJazzer
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
351
tixarah
T

Forum statistics

Threads
1,224,820
Messages
6,181,154
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top