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