Copy Check boxes

[BelfastHatter]

I am trying to get a macro that when a new person wants to vote on a poll, the check boxes are copied to the next empty column and any check marks are removed.

This Macro will be assigned to a button on the worksheet.

Your help in this is greatly appreciated.

 

[Gary McMaster]

The sample code below doesn't do any copying but I hope it will demonstrate how you could create and manipulate new sets of check boxes on the fly if that would work.

To try it, please paste the code in a standard module in a new workbook then run "CheckBox_Demo_Create".

Hope it helps.

Gary

Option Explicit

Sub CheckBox_Demo_Create()

Dim oShape As Shape
Dim oActive As Worksheet
Dim oCheckBox As CheckBox
Dim oRange As Range
Dim oCell As Range

Dim lWidth As Long
Dim lHeight As Long

lWidth = 100
lHeight = 12

Set oActive = ActiveSheet

Set oRange = oActive.Range("B1:B10")
oRange.ColumnWidth = 16
oRange.Offset(0, 1).ColumnWidth = 60

For Each oShape In oActive.Shapes
    If InStr(1, oShape.Name, "CheckBox") Then
        oShape.Delete
    End If
Next oShape

For Each oCell In oRange
    Set oCheckBox = oActive.CheckBoxes.Add(oCell.Left, oCell.Top, lWidth, lHeight)
    With oCheckBox
        '.LinkedCell = oCell.Address
        '.Interior.ColorIndex = 3
        .Name = "CheckBox_" & oCell.Address
        .Caption = .Name
        .OnAction = "Checkbox_Toggle"
    End With
Next oCell

End Sub

Public Sub CheckBox_Demo_Check_Uncheck()

Dim oShape As Shape
Dim oActive As Worksheet
Dim oCell As Range

Set oActive = ActiveSheet

For Each oShape In oActive.Shapes

If oShape.Type = msoFormControl Then
    If oShape.FormControlType = xlCheckBox Then
        If InStr(1, oShape.Name, "CheckBox") Then
            Set oCell = oShape.TopLeftCell
            If oShape.ControlFormat.Value = Checked Then
                oShape.ControlFormat.Value = Unchecked
            Else
                oShape.ControlFormat.Value = Checked
            End If
        End If
    End If
End If

Next oShape

End Sub

Public Sub Checkbox_Toggle()

Dim oShape As Shape
Dim oCell As Range
Dim oActive As Worksheet

Set oActive = ActiveSheet

Set oShape = oActive.Shapes(Application.Caller)

Set oCell = oShape.TopLeftCell

If oShape.ControlFormat.Value = Checked Then
    oCell.Offset(0, 1).Value = "The check box in cell" & oCell.Address & " named " & oShape.Name & " was checked"
Else
    oCell.Offset(0, 1).Value = "The check box in cell" & oCell.Address & " named " & oShape.Name & " was un-checked"
End If

End Sub