Checkbox Change Procedure

[AndyJM87]

Hi all,

I have a load of checkboxes where once ticked (or unticked) put a "X" into a cell.

Instead of:

    If Me.chkTempWarm.Value = True Then
        wsMain.Range("H25").Value = "X"
    ElseIf Me.chkTempWarm.Value = False Then
        wsMain.Range("H25").Value = ""
    End If

    If Me.chkTempMild.Value = True Then
        wsMain.Range("K25").Value = "X"
    ElseIf Me.chkTempMild.Value = False Then
        wsMain.Range("K25").Value = ""
    End If

So on a so forth,

Is there a simpler way to loop through all the checkboxes and, and once one is ticked, it will put the "X" in the relevant cell.

 

[bobsan42]

Are the checkboxes on a form ? From you code it seems yes.

One way is to set the controlsource property of the checkboxes on the form. Something like: ='Sheet3 (2)'!A24
Then Upon changing the value of the chkbox the value of the linked cell will change between TRUE and FALSE (this can then be transfered as formula if you need to see an X to another cell. no coding here.

Second way is to loop through all controls:

dim chb as control, str1 as string, varval as variant
 for each chb in Me.Controls
  select case chb.name
   case "[COLOR=#333333]chkTempWarm[/COLOR]": str1 = "[COLOR=#333333]H25[/COLOR]"
   case "chkTempMild": str1 = "K25"
   case else: str1 = ""
  end select
  if str1 <>"" then 
   if chb.value then varval="X" else varval=""
  else
   varval=null
  end if
  if not isnull(varval) then wsMain.range(str1).value = varval
 next chb

 

[Yongle]

Another way
- create 2 parallel arrays to hold the matching names \ cell references
- place procedure in SHEET module if checkboxes are on a worksheet or in USERFORM module (if on UserForm)

Sub XorNothing()
    Dim wsMain As Worksheet: Set wsMain = Sheets("MainSheet")
    Dim CBs, Refs, i As Long
[COLOR=#006400][I]'create arrays of parallel values [/I][/COLOR]
    CBs = Array(chkTempWarm, chkTempMild, chkTempCool, chkTempCold)
    Refs = Array("H25", "J25", "L25", "N25")
[I][COLOR=#006400]'loop [/COLOR][/I]
    For i = LBound(CBs) To UBound(CBs)
        wsMain.Range(Refs(i)).ClearContents
        If CBs(i) Then wsMain.Range(Refs(i)) = "X"
    Next i
End Sub

 

[AndyJM87]

Fantastic bobsan42, that code works a treat. Is there a way to go the other way, so if there is an X in a range, the CheckBox value is True?

Sub GetData()
Dim rng As Range
    For Each rng In wsMain
        Select Case wsMain.Range
            Case "H25" = "X": frmRGT.chkTempWarm.Vlaue = True
        End Select
    Next rng
    
End Sub

 

[bobsan42]

If you link the checkboxes to cells you will not need this code. Or even the one above.

However your code should look like this if you want it to work:

Sub GetData()
Dim rng As Range

    For Each rng In wsMain.Range ("[COLOR=#0000ff]H25:H50[/COLOR]")
    with rng
        Select Case .address
            Case "$H$25": frmRGT.chkTempWarm.Vlaue = (.Value="X")
            Case "$K$25": frmRGT.[COLOR=#333333]chkTempMild[/COLOR].Vlaue = (.Value="X")
            [COLOR=#0000ff]Case .................[/COLOR]
        End Select
    end with
    Next rng
End Sub

You need to adjust the bits in blue.