Macro code to circle items when checkbox is checked.

[aking154]

I have several worksheets with pricing and checkboxes that when checked total the costs up automatically. I have a code that adds the checkboxes for me automatcally and also links them to the proper cell for the true and false at the same time. I've added conditional formatting to make the price cell turn yellow and bold the type when the checkbox is checked, but when printed in black and white, this is not obvious enough that this is the choice that has been selected and the checkboxes are so small that you can hardly tell when they are checked. My question is can I add code to what I already have that will also add a circle around the price when the checkbox is checked? Here is the code I have:

Option Explicit<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
Sub insertCheckboxes()<o></o>
<o></o>
Dim myBox As CheckBox<o></o>
Dim myCell As Range<o></o>
<o></o>
Dim cellRange As String<o></o>
Dim cboxLabel As String<o></o>
Dim linkedColumn As String<o></o>
<o></o>
cellRange = InputBox(Prompt:="<?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1lace><st1:PlaceName>Cell</st1:PlaceName> <st1:PlaceType>Range</st1:PlaceType></st1lace>", _<o></o>
Title:="<st1lace><st1:PlaceName>Cell</st1:PlaceName> <st1:PlaceType>Range</st1:PlaceType></st1lace>")<o></o>
<o></o>
linkedColumn = InputBox(Prompt:="Linked Column", _<o></o>
Title:="Linked Column")<o></o>
<o></o>
cboxLabel = InputBox(Prompt:="Checkbox Label", _<o></o>
Title:="Checkbox Label")<o></o>
<o></o>
With ActiveSheet<o></o>
For Each myCell In .Range(cellRange).Cells<o></o>
With myCell<o></o>
Set myBox = .Parent.CheckBoxes.Add(Top:=.Top, _<o></o>
Width:=.Width, Left:=.Left, Height:=.Height)<o></o>
<o></o>
With myBox<o></o>
.LinkedCell = linkedColumn & myCell.Row<o></o>
.Locked = False 'This unlocks the checkbox also<o></o>
.Caption = cboxLabel<o></o>
.Name = "checkbox_" & myCell.Address(0, 0)<o></o>
End With<o></o>
<o></o>
.NumberFormat = ";;;"<o></o>
End With<o></o>
<o></o>
Next myCell<o></o>
End With<o></o>
End Sub<o></o>

 

[Jaafar Tribak]

Hi and welcome to the board.

Fisrt let me say that your code needs some fair amount of error trapping . I recommend you reedit your code to make it more error proof.

A while ago our board member Tom Urtis posted here a cool way to circle text without the need for adding shapes or VBA. It basically uses Data Validation.

I have built on this method to automate circling the text in your checkbox linked cells if they display TRUE every time the sheet is printed.

In a standard module : ( This is an amendment of your own code )

Option Explicit
 
Public olinkedColumn As Range
Public oActiveSheet As Worksheet
Public ocellRange As Range
 
Sub insertCheckboxes()
 
    Dim myBox As CheckBox
    Dim myCell As Range
    
    Dim cboxLabel As String
    
    Set ocellRange = _
    Application.InputBox(Prompt:="CellRange", _
    Title:="CellRange", Type:=8)
    
    Set olinkedColumn = _
    Application.InputBox(Prompt:="Linked Column", _
    Title:="Linked Column", Type:=8)
    
    Set oActiveSheet = ActiveSheet
    
    cboxLabel = InputBox(Prompt:="Checkbox Label", _
    Title:="Checkbox Label")
    
    With ActiveSheet
        For Each myCell In ocellRange.Cells
            With myCell
            Set myBox = .Parent.CheckBoxes.Add(Top:=.Top, _
            Width:=.Width, Left:=.Left, Height:=.Height)
            With myBox
                .LinkedCell = _
                Cells(myCell.Row, olinkedColumn.Column).Address
                .Locked = False 'This unlocks the checkbox also
                .Caption = cboxLabel
                .Name = "checkbox_" & myCell.Address(0, 0)
                With Range(.LinkedCell)
                    On Error Resume Next
                    .Validation.Delete
                    On Error GoTo 0
                    .Validation.Add Type:=xlValidateCustom, _
                    AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="=" & _
                    .Address(False, False) & "<>TRUE"
                    .Validation.ShowError = False
                End With
            End With
            .NumberFormat = ";;;"
            End With
        Next myCell
    End With
    
End Sub

And add this to the WorkBook module :

Option Explicit
 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
 
Dim lRowsCount As Long
 
On Error Resume Next
    If Not oActiveSheet Is Nothing Then
    If ActiveSheet Is oActiveSheet Then
        With ActiveSheet
            .CircleInvalid
            lRowsCount = ocellRange.Rows.Count
            olinkedColumn.Range _
            (ocellRange.Cells(1, 1), _
            ocellRange.Cells(lRowsCount, 1)).Select
            Selection.CopyPicture _
            Appearance:=xlScreen, Format:=xlBitmap
            .Paste
            .ClearCircles
            Application.OnTime Now + _
            TimeSerial(0, 0, 1), Me.CodeName & ".RemoveCircles"
        End With
    End If
    End If

End Sub

Private Sub RemoveCircles()
 
    Selection.Delete
    ocellRange.Cells(1).Select
 
End Sub

I hope this helps.

Regards.

 

[aking154]

Thank you so much, Jafar. The code I originally had was something that I found - I am a novice when it comes to writing code and could never have done that - errors or not!

I'm running into an issue with the code you provided. I've added them to my modules and the workbook like you said, however, the checkboxes are added fine, but there are no circles coming up when I click on the checkboxes. Also - when I go to the workbook and run the macro, I'm getting an error notice - "Compile Error - Variable not defined" and it's highlighting "ocellrange" - do I need to add in the cell range that I used for the checkboxes?

Thank you again!

 

[Jaafar Tribak]

When you click on the checkboxes, no circles should come up. The circles will appear only when you print the worksheet or print- preview the worksheet.
That is what you requested on your original post.

here is a workbook demo.

Note the code should be run once .

Regards.

 

[aking154]

HI Jaafar,

I'm sorry that I'm not as adept at this as I should be, but I cannot get this to work and I cannot open the demo - I just get a free offer that won't allow me to open the page at all unless I enter my address and information.

I keep getting the error messages and I'm not sure what you mean by the fact that I can only run the macro once, as I have several columns to add checkboxes to. Can you elaborate further, please?

Thank you!

 

[Jaafar Tribak]

Hi,

I am sorry but i am really busy at the moment.

See if you can download the workbook demo from this link.

Regards.