Checkbox Loop

Hi All!

So this is been an interesting little bit of trial and error...more error than anything.

I have a userform, as seen below, which has 50 checkboxes. During the initialize event, these checkboxes are made visible, or not, based on whether a cell in a sheet is populated, and then their captions are changed to show that cell's value. The returned userform should have "x" number of checkboxes, with the appropriate captions. The problem is the loop seems to skip any Checkbox that is an even value.

Naming references: I have left checkboxes all as their "default" name for the sake of the loop coding, so they are CheckBox1, CheckBox2, etc...

I have two images attached, one is the coding version of the userform, and the other is the end-user (currently) userform.

Code:

---

Private Sub UserForm_Initialize()   
    MEFLabel.Caption = ActiveCell.Value
   
    Call Checkbox_Start
   
End Sub


Private Function Checkbox_Start()


    Dim i As Long
    Dim y As Long
    Dim ctl As Control
   
    i = 1
   
    y = 2
   
    For i = 1 To 50
        Set ctl = Me.HazardsFrm.Controls("CheckBox" & i)
        If wsHazRanking.Range("B" & y).Value <> "" Then
            ctl.Visible = True
            ctl.Caption = wsHazRanking.Range("B" & y).Value
        Else
            ctl.Visible = False
        End If
        i = i + 1
        y = y + 1
    Next
   
End Function

---

Attachment 21895

Attachment 21896

The second image should either have all the even CheckBoxes not visible, or have captions different. There are currently ten "hazards" to populate the checkboxes, so ideally there would be five per side, and the rest would be invisible.

Any help is greatly appreciated. And as always, I CANNOT upload the spreadsheets, the images are as much as I can do.

Thank you!

Code:

---

  For i = 1 To 50
        Set ctl = Me.HazardsFrm.Controls("CheckBox" & i)
        If wsHazRanking.Range("B" & I+1).Value <> "" Then ' change
            ctl.Visible = True
            ctl.Caption = wsHazRanking.Range("B" & I+1).Value ' change
        Else
            ctl.Visible = False
        End If
        i = i + 1  ' <<<<<<<<<<<<<<<<<<<<<<<<< delete this line
        y = y + 1  ' <<<<<<<<<<<<<<<<<<<<<<<<< delete this line
    Next

---

HAHAHAHA:rofl::rofl::rofl::rofl::rofl::rofl::rofl:

I knew it had to be something simple that I was just overlooking.:rofl::rofl::rofl::rofl:

Thanks for the help! Marking it as solved!

HAHAHAHA:rofl::rofl::rofl::rofl:

So the primary problem is solved, but now I have a secondary issue related to this. I need to now take the captions of the selected checkboxes, look them up, and return a different value.

The problem seems to come from the "lookup = ...." The funny thing is, I had this working 30 minutes ago, but then excel crashed, and I wasn't able to recover any of my work. Of course, easy fix is save frequent and often, but I don't always remember to.

Code:

---

Private Function AddValues()   
    Dim i As Integer
    Dim lookfor As Variant
    Dim rng As Range
    Dim y As Variant
   
    i = 1
   
    Set rng = wsLists.Range("O2:Q51")
   
    For i = 1 To 50
        Set lookfor = Me.HazardsFrm.Controls("CheckBox" & i).Caption
        Set y = WorksheetFunction.VLookup(lookfor, rng, 3, False)
        If Me.HazardsFrm.Controls("CheckBox" & i).Value = True Then
            Call FindEmptyCell
            ActiveCell.Value = y
        End If
    Next
         
End Function

---

So update to above, I have slightly changed the code, but also the lookup location (streamlining purposes). See below:

Code:

---

Private Function AddValues()   
    Dim i As Integer
    Dim ctl As Control
    Dim str As Variant
    Dim y As Variant
    Dim lookfor As Variant
    Dim rng As Range
   
    Set rng = wsLists.Columns("O:T")
   
    i = 1
   
    For i = 1 To 50
        Set ctl = Me.HazardsFrm.Controls("CheckBox" & i)
        Set lookfor = ctl.Caption
        Set y = WorksheetFunction.VLookup(lookfor, wsLists.Columns(2), False)
        Set str = WorksheetFunction.VLookup(lookfor, wsLists.Columns(3), False)
       
        If ctl.Value = True Then
            Call FindEmptyCell
            ActiveCell.Value = str
        End If
    Next
         
End Function

---

My mind reading helmet with the built in telescopic sights needs new batteries, so this is just a very big guess from looking at the code

Code:

---

Option Explicit

Private Function AddValues()
    Dim i As Integer
    Dim ctl As Control
    Dim str As Variant
    Dim y As Variant
    Dim lookfor As Variant
    Dim rng As Range
   
    Set rng = wsLists.Columns("O:T")
   
'    i = 1      NOT NEEDED
   
    For i = 1 To 50
        Set ctl = Me.HazardsFrm.Controls("CheckBox" & i)
        Set lookfor = ctl.Caption
       
'  YOU SET rng ABOVE - O:T
       
'  THESE ARE WRONG SYNTAX FOR VLOOKUP
'  VLOOKUP DOES NOT RETURN OBJECT, SO NO 'SET'
        Set y = WorksheetFunction.VLookup(lookfor, wsLists.Columns(2), False)
        Set str = WorksheetFunction.VLookup(lookfor, wsLists.Columns(3), False)
       
       
'  BY ANY POSSIBLE CHANCE DID YOU MEAN <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        y = WorksheetFunction.VLookup(lookfor, rng, 2, False)    ' col P
        str = WorksheetFunction.VLookup(lookfor, rng, 3, False)  ' col Q
       
        If ctl.Value = True Then
            Call FindEmptyCell
            ActiveCell.Value = str
        End If
    Next
         
End Function

---

The problem tends to be in the ctl.caption, as it returns "Empty", which it shouldn't. I utilized, as you can see, very similar code as above, but for whatever reason the code doesn't like Me.HazardsFrm.Controls("CheckBox" & i).Caption, and I have tried this without setting ctl, and with dropping the hazardsfrm, and dropping me. It just doesn't like it and I can't seem to figure out why.

Try this

Code:

---


Dim lookfor As String

.....

lookfor = ctl.Caption

---

Again, the simplest of errors was the fix. Thanks!

I can't get this to work