Loop through checkboxes on a sheet - excel

Question

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

Answer 1

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

Answer 2

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