CODEWITHSUNDEEP
vbaexcel
ReigningData
ReigningData

Reputation: 3

Excel VBA script to insert multiple checkboxes linked to cell with yes and no instead of true and false

I am working on a massive excel file were I need to insert multiple cells with checkboxes and I need those boxes attached to the cell they appear over and I need the output to say "Cleared" or "" verses currently they say "True" or "False". So far I have the following code to mass produce the cells but now I need to tweak this code to change the output to say "Cleared" or "" verses "True" or "False".

Sub AddCheckBoxes()

Dim cb As CheckBox
Dim myRange As Range, cel As Range
Dim wks As Worksheet

Set wks = Sheets("Sheet1") 

Set myRange = wks.Range("A1:A1000")

For Each cel In myRange

    Set cb = wks.CheckBoxes.Add(cel.Left, cel.Top, 30, 6)


    With cb

        .Caption = ""
        .LinkedCell = cel.Address

    End With

Next

End Sub

Can anyone help me figure this out?

Upvotes: 0

Views: 3836

Answers (3)

user6432984
user6432984

Reputation:

enter image description here

Sub AddCheckBoxes()

    Dim cb As CheckBox
    Dim myRange As Range, cel As Range
    Dim wks As Worksheet

    Set wks = Sheets("Sheet1")

    Set myRange = wks.Range("A1:A1000")

    For Each cel In myRange

        Set cb = wks.CheckBoxes.Add(cel.Left, cel.Top, 30, 6)

        With cb
            .Caption = ""
            .OnAction = "ProcessCheckBox"
        End With

    Next

End Sub

Sub ProcessCheckBox()
    Dim cb As CheckBox
    With Sheets("Sheet1")
        Set cb = .CheckBoxes(Application.Caller)
        If Not cb Is Nothing Then cb.TopLeftCell = IIf(cb.Value = 1, "Cleared", "")
    End With
End Sub

Important: The ProcessCheckBox() module has to be in a standard module. If it is a worksheet module you will receive this message:

enter image description here

If you to make the code more flexible you can use the combo-box's index or name in a Select Case statement to decide on what your final output will be.

Sub ProcessCheckBox()
    Dim cb As CheckBox

    With Sheets("Sheet1")

        Set cb = .CheckBoxes(Application.Caller)
        If Not cb Is Nothing Then

            Select Case cb.Index
            Case 1, 2, 4
                cb.TopLeftCell = IIf(cb.Value = 1, "Cleared", "")
            Case 3, 5, 7
                cb.TopLeftCell = IIf(cb.Value = 1, 1, 0)
            Case Else
                cb.TopLeftCell = IIf(cb.Value = 1, True, False)
            End Select

        End If

    End With
End Sub

Upvotes: 1

user3598756
user3598756

Reputation: 29421

you could adopt a Shapes approach like follows:

Option Explicit

Sub AddCheckBoxes()           
    With Sheets("Sheet1")
        AddRangeCheckBoxes .Range("A1:A2"), "|YES\NO"
        AddRangeCheckBoxes .Range("B1:B2"), "|Cleared\"
    End With
End Sub

Sub AddRangeCheckBoxes(rng As Range, outputs As String)
    Dim cel As Range

    With rng.Parent
        For Each cel In rng
            With .Shapes.AddFormControl(xlCheckBox, cel.Left, cel.Top, 30, 6)
                .TextFrame.Characters.Text = ""
                .AlternativeText = cel.Address(False, False) & outputs
                .OnAction = "UpdateCheckBox"
            End With
        Next cel
    End With
End Sub

Sub UpdateCheckBox()
    Dim cellAddr As String
    Dim val As String

    With Worksheets("Sheet1")
        With .Shapes(Application.Caller)
            cellAddr = Split(.AlternativeText, "|")(0)
            val = Split(Split(.AlternativeText, "|")(1), "\")(IIf(.OLEFormat.Object.Value = 1, 0, 1))
        End With
        .Range(cellAddr).Value = val
    End With
End Sub

Upvotes: 2

vacip
vacip

Reputation: 5406

Hide the column with the true/false, and insert another column next to it with an IF formula referencing the true/false (=IF(B1,"Cleared","Not cleared"))

Sub AddCheckBoxes()

Dim cb As CheckBox
Dim myRange As Range, cel As Range
Dim wks As Worksheet

Set wks = Sheets("Sheet1")

Set myRange = wks.Range("A1:A1000")

For Each cel In myRange

    Set cb = wks.CheckBoxes.Add(cel.Left, cel.Top, 30, 6)


    With cb

        .Caption = ""
        .LinkedCell = cel.Address

    End With

    cel.Offset(0, 1).FormulaR1C1 = "=IF(RC[-1],""Cleared"",""Not cleared"")"

Next

wks.Range("A:A").EntireColumn.Hidden = True

End Sub

You might want to adjust column widths and text alignments as the boxes now overlap with the text.

Upvotes: 0

Related Questions