Here is some code you might find useful. It uses column(s) of cells as tickboxes that toggle when double-clicked. It solves several problems - such as having to set up and align numerous controls, which, if from the Controls Toolbox could contain bugs.
Format the column(s) as Wingdings font etc.. The code goes into the worksheet code module (right click sheet tab/'View Code')
It is easy to use a formula in a worksheet like
=IF(A1="",B1,C1)
or write code that looks for non-blank cells in the ranges for further automation.
Format the column(s) as Wingdings font etc.. The code goes into the worksheet code module (right click sheet tab/'View Code')
It is easy to use a formula in a worksheet like
=IF(A1="",B1,C1)
or write code that looks for non-blank cells in the ranges for further automation.
Code:
'------------------------------------------------------
'- WORKSHEET CHECKBOX ALTERNATIVE
'- ADDS OR REMOVES TICK IN A CELL. Font = Wingdings.
'- This example uses columns B and E.
'- and rows 10 to 38
'- Brian Baulsom October 2000
'------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, _
Cancel As Boolean)
Dim MyTick As String
MyTick = Chr(252)
TopRow = 10
BottomRow = 38
'-
If (ActiveCell.Column = 2 Or ActiveCell.Column = 5) _
And ActiveCell.Row >= TopRow _
And ActiveCell.Row <= BottomRow Then
If ActiveCell = "" Then
ActiveCell.Value = MyTick
Else
ActiveCell.Value = ""
End If
ActiveCell.Offset(1, 0).Select
Else
MsgBox ("Cannot tick here.")
End If
End Sub
'-------------------------------------------------------------------------
Code:
'==================================================
'- CHECK FOR TICKS IN COLUMN B
'- PRINT APPROPRIATE WORKSHEET (name in column C)
'==================================================
Sub CheckForTicks()
Dim Toprow As Long
Dim BottomRow As Long
Dim MySheet As String
'------------------------------
Toprow = 10
BottomRow = 38
For r = Toprow To BottomRow
If ActiveSheet.Cells(r, 2).Value <> "" Then
MySheet = ActiveSheet.Cells(r, 3).Value
WorkSheets(MySheet).PrintOut
End If
Next
End Sub
'====================================================
