VBA to add checkbox in another column based on word in a column

[kenchristensen11]

Hello!

In Column B, I have dropdowns for each cell, and I need a blank check box to appear in Column F if the cell value in Column B = "All QTRs", and leave the corresponding cell in Column F blank if that value is not selected in Column B. The data starts in cell B9 (first checkbox would be F9 if B9 = "All QTRs"), and I would like this to loop/search all of Column B as the user changes/adds more data.

The blank check box would also allow the user to check/uncheck once it appears after the macro is run.

Thanks!

 

[OaklandJim]

Here is a link to a workbook that does what you asked for (if I understand your request). Note use of Worksheet_Change "event handler" that adds checkboxes if there is a change to the worksheet.

Let me know if it works.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Call AddCheckboxes

End Sub

Option Explicit

Sub AddCheckboxes()

    Dim wsData As Worksheet

    Dim rAnchorCell As Range
   
    Dim rCheckboxCell As Range
   
    Dim oCheckbox As Object
   
    Dim iRowsToProcessCount As Long
   
    Dim iRow As Long
   
    Dim iTargetCellLeft As Long
   
    Dim iTargetCellTop As Long
   
    Dim iCheckboxCellOffset As Long
   
    Set wsData = Worksheets("Sheet1") '<= change if the tab/name of the worksheet changes.
   
    Set rAnchorCell = wsData.Range("B1") '<= change if the data location changes.
   
    iCheckboxCellOffset = 4 '<= change if the column containing checkboxes changes.
       
    iRowsToProcessCount = rAnchorCell.Cells(Rows.Count, 1).End(xlUp).Row - rAnchorCell.Row
   
    Call DeleteAllCheckboxes(wsData, "PeriodCheckBox")

    For iRow = 1 To iRowsToProcessCount

        If UCase(rAnchorCell.Offset(iRow).Value) = "ALL QTRS" _
         Then
            Set rCheckboxCell = rAnchorCell.Offset(iRow, iCheckboxCellOffset)

            With rCheckboxCell

                iTargetCellLeft = .Left

                iTargetCellTop = .Top

            End With

            Set oCheckbox = wsData.CheckBoxes.Add(iTargetCellLeft, iTargetCellTop, 17.25, 17.25)

            oCheckbox.Characters.Text = ""

            oCheckbox.Name = "PeriodCheckBox" & iRow

        End If

    Next iRow

End Sub


Private Sub DeleteAllCheckboxes(pwsSheet As Worksheet, psCheckBoxName As String)

    Dim cbCurrent As CheckBox
   
    For Each cbCurrent In ActiveSheet.CheckBoxes

        If UCase(cbCurrent.Name) Like UCase(psCheckBoxName) & "*" _
         Then cbCurrent.Delete
   
    Next cbCurrent

End Sub

 

[OaklandJim]

I apologize. That version of the workbook does not work. I will repost soon.

 

[OaklandJim]

Hopefully this version works as expected.

Option Explicit

Sub AddCheckboxes()

    Dim wsData As Worksheet

    Dim rAnchorCell As Range
    
    Dim rCheckboxCell As Range
    
    Dim oCheckbox As Object
    
    Dim iRowsToProcessCount As Long
    
    Dim iRow As Long
    
    Dim iTargetCellLeft As Long
    
    Dim iTargetCellTop As Long
    
    Dim iCheckboxCellOffset As Long
    
    Set wsData = Worksheets("Sheet1") '<= change if the tab/name of the worksheet changes.
    
    Set rAnchorCell = wsData.Range("B8") '<= change if the data location changes.
    
    iCheckboxCellOffset = 4 '<= change if the column containing checkboxes changes.
        
    iRowsToProcessCount = rAnchorCell.Offset(10000).End(xlUp).Row - rAnchorCell.Row
    
    Call DeleteAllCheckboxes(wsData, "PeriodCheckBox")

    For iRow = 1 To iRowsToProcessCount

        If UCase(rAnchorCell.Offset(iRow).Value) = "ALL QTRS" _
         Then
            Set rCheckboxCell = rAnchorCell.Offset(iRow, iCheckboxCellOffset)

            With rCheckboxCell

                iTargetCellLeft = .Left

                iTargetCellTop = .Top

            End With

            Set oCheckbox = wsData.CheckBoxes.Add(iTargetCellLeft, iTargetCellTop, 17.25, 17.25)

            oCheckbox.Characters.Text = ""

            oCheckbox.Name = "PeriodCheckBox" & iRow

        End If

    Next iRow

End Sub


Private Sub DeleteAllCheckboxes(pwsSheet As Worksheet, psCheckBoxName As String)

    Dim cbCurrent As CheckBox
    
    For Each cbCurrent In ActiveSheet.CheckBoxes

        If UCase(cbCurrent.Name) Like UCase(psCheckBoxName) & "*" _
         Then cbCurrent.Delete
    
    Next cbCurrent

End Sub