CODEWITHSUNDEEP
excelvba
Lawrence Ferguson
Lawrence Ferguson

Reputation: 321

Loop through checkboxes on a sheet

How would I create the following as a Loop.

Basically the first list to loop would be selectStatus, selectSite, These are check boxes on a sheet. (The below code only includes two but the full macro has about 60 to loop)

The second loop would be the values "Header 1", "Header 2", etc. so they would both loop and change together. The first one being the checkbox name and the second being a corresponding SQL header which I want at the end to create a string.

    Sub TEST2()

    If Sheets("controlSheet").selectStatus.Value = True Then
    a = "Header 1, "
    Else
    a = ""
    End If

    If Sheets("controlSheet").selectSite.Value = True Then
    a = a + "Header 2, "
    Else
    a = a + ""
    End If

    End Sub

Upvotes: 0

Views: 3616

Answers (2)

David Zemens
David Zemens

Reputation: 53623

This should handle ActiveX checkboxes.

NOTE: This requires your checkboxes are indexed correctly (i.e., the first one by index will correspond to "Header 1", the second with "Header 2", the nth with "Header n", etc...). If they are out of order, you'd need additional logic to control for that (see the other answer for a good solution if that is the case).

Option Explicit
Sub LoopActiveXCheckBoxes()

Dim ws As Worksheet
Dim obj As OLEObject
Dim cb As CheckBox
Dim i As Long
Dim a As String

Set ws = Sheets("controlSheet")
For Each obj In ws.OLEObjects
    If TypeName(obj.Object) = "CheckBox" Then
        i = i + 1
        If obj.Object.Value = True Then
            a = a & "Header " & CStr(i) & ","
        End If
    End If
Next
If Len(a) > 0 Then a = Left(a, Len(a) - 1)

End Sub

For Form Control checkboxes, this would work but I'm pretty sure you're using ActiveX.

Sub LoopCheckBoxes()

Dim ws As Worksheet
Dim cb As CheckBox
Dim i As Long
Dim a As String

Set ws = Sheets("controlSheet")
For Each cb In ws.CheckBoxes
    i = i + 1
    If cb.Value = 1 Then
        a = a & "Header " & CStr(i) & ","
    End If
Next
If Len(a) > 0 Then a = Left(a, Len(a) - 1)

End Sub

Upvotes: 2

basodre
basodre

Reputation: 5770

Here's one header where you can create an object to hold a list of the mapping between control name and header name. Let me know of any questions.

Dim oDictHeaders As Object

Function GetHeaders() As Object
    If oDictHeaders Is Nothing Then
        Set oDictHeaders = CreateObject("Scripting.Dictionary")

        oDictHeaders("SelectSite") = "Header 1"
        oDictHeaders("SelectStatus") = "Header 2"
        oDictHeaders("SelectOther") = "Header 3"
    End If

    Set GetHeaders = oDictHeaders
End Function


Function GetListOfHeaders() As String
    Dim sOutput As String
    Dim oDict As Object
    Dim ctl As Object

    sOutput = ""

    Set oDict = GetHeaders()

    For Each ctl In Sheet1.OLEObjects
    Debug.Print TypeName(ctl.Object)
        If TypeName(ctl.Object) = "CheckBox" Then
            If ctl.Object.Value = True Then
                sOutput = sOutput & ", " & oDict(ctl.Name)
            End If
        End If
    Next ctl

    GetListOfHeaders = Mid(sOutput, 2)
End Function

Sub Test()
    MsgBox (GetListOfHeaders())
End Sub

Upvotes: 1

Related Questions