creating multiple checkboxes in a spreadsheet

Hello

Sheello some things where missing, i added them. Also i created a macro to erase checkboxes (if one cell is selected then erases all checkboxes within sheet, otherwise it tries to erase only within selection boundaries...)

Now the creator Sub will:

• Create Checkboxes
• Resize columns/Rows if to small (can be ommitted, read comments inside)
• Link to cell
• Specify Checkbox Column (will fit inside) / Row (same)
• Specify Starting Row and Ending Row

what else could anyone want????

:D give it a try and tell me what you think of it.

I Thank again Sheeloo for the ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _DisplayAsIcon:=False, Left:=dblLeft, Top:=dblTop, Width:=dblWidth, Height:= _  dblHeight).Select code, couldn't (wouldn't) have done it without it.

Copy paste code below or download from here

'------------CODE START HERE-----------

' Create and Link many Checkboxes

'

Sub CheckBoxCreator()

Dim dblTop As Double, dblLeft As Double, dblWidth As Double, dblHeight As Double

Dim Irw As Long, ChBoxClmn As Long, LinkClmn As Long, I As Long, Qnty As Long

Irw = 5 ' Row to start from

ChBoxClmn = Range("d1").Column ' Where (column) to place the CheckBox

LinkClmn = ChBoxClmn - 1 ' Where (column) to make the link

Iend = 10 ' Row to Stop

If Columns(ChBoxClmn).ColumnWidth < 20 Then Columns(ChBoxClmn).ColumnWidth = 20 'Suggested Width fix

For I = Irw To Iend

If Rows(I).RowHeight < 20 Then Rows(I).RowHeight = 20 ' Suggested Height fix

With Cells(I, 4)

dblTop = .Top: dblLeft = .Left: dblWidth = .Width: dblHeight = .Height

End With

ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _

DisplayAsIcon:=False, Left:=dblLeft, Top:=dblTop, Width:=dblWidth, Height:= _

dblHeight).Select

Selection.LinkedCell = Cells(I, LinkClmn).Address(False, True)

Next

End Sub

' Erase all checkboxes in sheet (single cell selected) or all checkboxes

' within selected region

'

Sub CheckboxEraser()

Dim dblTop As Double, dblLeft As Double, dblWidth As Double, dblHeight As Double

Dim A

If Selection.Cells.Count = 1 Then

For Each A In ActiveSheet.Shapes

If InStr(LCase(A.Name), "checkbox") > 0 Then A.Delete

Next

Else

With Selection

dblTop = .Top: dblLeft = .Left: dblWidth = .Width: dblHeight = .Height

End With

For Each A In ActiveSheet.Shapes

If InStr(LCase(A.Name), "checkbox") > 0 Then

If A.Top >= dblTop And A.Top < dblTop + dblHeight And A.Left > dblLeft And A.Left < dblLeft + dblWidth Then

A.Delete

End If

End If

Next

End If

End Sub

'---------CODE END HERE------------

You may try a macro like the one below;

Sub insertCheckBoxes()

'

' insertCheckBoxes Macro

'

Dim dblTop, dblLeft, dblWidth, dblHeight As Double

Dim i As Long

dblTop = 30

dblLeft = 150

dblWidth = 32

dblHeight = 32

For i = 1 To 10

dblTop = dblTop + 20

ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _

    DisplayAsIcon:=False, Left:=dblLeft, Top:=dblTop, Width:=dblWidth, Height:= _

    dblHeight).Select

Next

End Sub

Hi

Would Data Validation not be easier ?

Regards

JY