Insert checkbox in a relative position using VBA macro

[seleseped]

Hello,
I have a bulleted list of various treatment options which changes depending on the parameters entered. The bullets are derived using VBA code and output into a single Excel spreadsheet cell. The list bullets are each on a separate line using the vbNewLine code, e.g., (the code has been simplified for clarity):
"RECOMMEND TREATMENT OPTIONS:" _
& vbNewLine & "° " & " ounces juice or regular pop," _
& vbNewLine & "° OR " & " tablespoon" & TBSP & " jelly or sugar," _
& vbNewLine & "° OR " & " tube" & TUBES & " glucose gel."

There can be anywhere from 3 to 6 bullets in any particular list. I would like to have a macro insert a checkbox in front of or in place each of the bullet symbols.

I have this macro: ActiveSheet.CheckBoxes.Add(50, 50, 10, 20).Select
which works but inserts the checkbox in an absolute position relative to the spreadsheet. What I was hoping for was code that would 'float' the checkboxes and attach each to a bullet point in a relative position since the number of bullets in the cell is variable and the height of the cell itself also varies based on the content of the row above it.

What I was hoping for was something that would look like this (where the ° symbol represents a checkbox):
RECOMMEND TREATMENT OPTIONS:
° 6 ounces juice or regular pop,
° OR 1 tablespoon jelly or sugar,
° OR 1 tube glucose gel.

Many thanks in advance for your time, effort and expertise.

 

[pbornemeier]

Can't think of a way to do exactly what you want (replace bullets in a single cell with a textbox). Perhaps this will suffice:

Option Explicit

Sub AddCheckBoxes()

    Dim sngCellHeight As Single
    Dim lCheckBoxCount As Long
    Dim lX As Long
    Dim rngTreatment As Range
    Dim aryList() As Variant
    Dim sOutput As String
    Dim sngCheckBoxRowHeight As Single
    Dim sngVertAdjust As Single
    
    'Your code develops aryList
    ReDim Preserve aryList(1 To 3)
    aryList(1) = "12 ounces juice or regular pop,"
    aryList(2) = "OR 2 tablespoon(s) jelly or sugar,"
    aryList(3) = "OR 1 tube glucose gel."
    'So this block of code not needed in your program
    
    sngVertAdjust = -1
    lCheckBoxCount = UBound(aryList)
    
    For lX = 1 To lCheckBoxCount
        sOutput = sOutput & " " & vbNewLine
    Next
    sOutput = "RECOMMEND TREATMENT OPTIONS:" & sOutput
    
    With ActiveSheet
        For lX = ActiveSheet.Shapes.Count To 1 Step -1
            If Left(ActiveSheet.Shapes(lX).Name, 10) = "chkOption_" Then ActiveSheet.Shapes(lX).Delete
        Next
        Set rngTreatment = .Range("D4")
        With rngTreatment
            .ClearContents
            .EntireRow.AutoFit
            .Value = sOutput
            sngCellHeight = .Height
            sngCheckBoxRowHeight = sngCellHeight / (lCheckBoxCount + 1)
            .ColumnWidth = 100
            For lX = 1 To lCheckBoxCount
                ActiveSheet.CheckBoxes.Add(.Left, .Top + sngVertAdjust + CSng(lX * sngCheckBoxRowHeight), .Width, sngCheckBoxRowHeight).Select 'L T W H
                With Selection
                    .Caption = aryList(lX)
                    .Name = "chkOption_" & lX
                End With
            Next
        End With
    End With
    Set rngTreatment = Nothing
End Sub

 

[seleseped]

Thanks! There's no way I would have come up with that. As you said, it doesn't do exactly what I had described but I was able to use the code to accomplish a similar end.