Macro to insert a checkbox based on value in another cell

[kenchristensen11]

I'd like a macro to insert a checkbox starting in cell F9 if the value in column B (starting with B9) contains the phrase, "All QTRs". It needs to loop and check through every row in the worksheet and add checkbox in column F whenever "All QTRs" is in column B.

Any help would be greatly appreciated!!

 

[Domenic]

Assuming the following...

1) You want the checkbox from Form Controls, not ActiveX controls.

2) You don't want a caption for the checkbox.

3) You want the checkbox centered within the cell.

4) The workbook running the code contains the sheet for which to add checkboxes.

5) The sheet for which to add checkboxes is called "Sheet1"

If in fact the checkbox is from ActiveX controls, post back and I'll amend the code accordingly. Here's the code...

Option Explicit

Sub InsertCheckBoxes()

    Dim targetWorksheet As Worksheet
    Set targetWorksheet = ThisWorkbook.Worksheets("Sheet1")

    Dim lastRow As Long
    With targetWorksheet
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With
    
    Dim searchRange As Range
    Set searchRange = targetWorksheet.Range("B9:B" & lastRow)
    
    Dim searchFor As String
    searchFor = "All QTRs"
    
    Dim foundCell As Range
    Dim firstAddress As String
    With searchRange
        Set foundCell = .Find(what:=searchFor, lookat:=xlPart, MatchCase:=False)
        If Not foundCell Is Nothing Then
            firstAddress = foundCell.Address
            Do
                addCheckBox foundCell.Offset(0, 4)
                Set foundCell = .FindNext(foundCell)
            Loop While foundCell.Address <> firstAddress
        End If
    End With
    
End Sub

Private Sub addCheckBox(ByVal targetCell As Range)

    Dim targetWorksheet As Worksheet
    Set targetWorksheet = targetCell.Parent
    
    Dim newCheckBox As CheckBox
    Set newCheckBox = targetWorksheet.CheckBoxes.Add(targetCell.Left, targetCell.Top, 18, 18)
    
    With newCheckBox
        .Caption = ""
        .LinkedCell = targetCell.Offset(0, 1).Address(external:=True)
        .Value = xlOff
        .Left = .Left + (targetCell.Width - .Width) / 2
        .Top = .Top + (targetCell.Height - .Height) / 2
    End With
    
End Sub

Hope this helps!

 

[kenchristensen11]

This is EXTREMELY helpful, Domenic!!! How do I get rid of the True/False that pops up in the adjacent column (G)?

 

[Domenic]

This is EXTREMELY helpful, Domenic!!!

That's great to hear, glad I could help.

How do I get rid of the True/False that pops up in the adjacent column (G)?

You could just simply remove the following line of code...

.LinkedCell = targetCell.Offset(0, 1).Address(external:=True)

Cheers!

 

[kenchristensen11]

No need to reply, Domenic as I removed the linked cell line. I really appreciate the help

That's great to hear, glad I could help.


You could just simply remove the following line of code...

.LinkedCell = targetCell.Offset(0, 1).Address(external:=True)

Cheers!

Thank you SO VERY MUCH!!!!! You made my weekend and I hope you have a great weekend!!!!

 

[Domenic]

Thank you, and you have a great weekend too!!!

Cheers!!!

 

[kenchristensen11]

Hi Domenic,

Hope all is well!! One more question: when the user changes the value from "ALL QTRs" to another value, the checkbox remains. Is it possible to remove the checkbox if the user selects a different value in column B AFTER the macro has already run?