Changing CheckBox Control Names

[grime]

I have a sheet that contains 180 checkboxes in a 20 x 9 grid.

The names of those checkboxes are all over the place, and I want the
names for the first row of boxes to be CheckBox 10, CheckBox 11...
CheckBox 18. Next Row is CheckBox 20, CheckBox 21...

And so on...

I can change the name by using the name box, but with so many, it would
be much easier to use a macro. I think using a loop, with a
SendKeys("{TAB"}) will work, but I can't seem to find the code that
will change the name.

Someone help!

Thanks in advance.

 

[Peter T]

As it appears you have moved checkboxes all over the place it's not
straightforward to loop through renameing them according to their grid
positions.

Far easier, I think, to start afresh. Try the following on a new sheet and
adapt to your needs. Apart from locations you will probably want to work out
where you want your linked cells.

Adds checkboxes from the "Forms" menu:

Sub CBgrid()
Dim d As Long, i As Long
Dim rw As Long, cl As Long, dr As Long
Dim lt As Single, tp As Single
Dim ch As CheckBox
Dim ws As Worksheet

Set ws = ActiveSheet
'ws.CheckBoxes.Delete

For d = 10 To 200 Step 10
dr = dr + 2
tp = Rows(dr).Top
For i = 0 To 8
lt = Columns(i * 2 + 3).Left
rw = rw + 1
Set cel = Cells(rw, 1)
With ws.CheckBoxes.Add(lt, tp, 76.5, 20)
.Name = "CheckBox " & (d + i)
.Caption = .Name
.Placement = xlMove
cel.Value = .Name
.LinkedCell = cel.Offset(0, 1).Address
End With
Next
Next
Columns("A:A").EntireColumn.AutoFit

End Sub

If you are going to use this, I suggest first delete all your existing
checkboxes and anyother shapes on the sheet, save & reopen to reset the new
object counter.

Regards,
Peter T

 

[Peter T]

PS forgot to include in the demo

Dim cel As Range

Peter T

 

[Leith Ross]

Hello Grime,

Quite a project you've made for yourself. As Peter said looping throug
the chackboxes isn't starightforward due to cell positions and the inde
numbers. However, after some thought and testing, this macro should d
it for you. This code will only work on CheckBoxes created using th
Forms Toolbar not on Control Toolbox CheckBoxes!


Code
-------------------
Public Sub RenameCheckBoxes()

Dim CB()
Dim Cnt As Long
Dim I As Long
Dim J As Long
Dim N As Long
Dim Tmp

Cnt = Shapes.Count
If Cnt = 1 Then Exit Sub

ReDim Preserve CB(1, 0)

'Get the addresses of all Form Checkboxes on the Worksheet
'CB(0, N) = Cell Address of the CheckBox
'CB(1, N) = Shape Index Number for the CheckBox
For I = 1 To Cnt
With Shapes(I)
If .Type = msoFormControl Then
If .FormControlType = xlCheckBox Then
N = N + 1
ReDim Preserve CB(1, N)
CB(0, N) = .TopLeftCell.Address
CB(1, N) = I
End If
End If
End With
Next I

'Sort the CheckBoxes by address and index
For I = 1 To N
For J = 1 To N - 1
If CB(0, I) < CB(0, J) Then
Tmp = CB(0, I)
CB(0, I) = CB(0, J)
CB(0, J) = Tmp
Tmp = CB(1, I)
CB(1, I) = CB(1, J)
CB(1, J) = Tmp
End If
Next J
Next I

'Rename the CheckBoxes - 20 x 9 Grid
N = 0
For I = 0 To 8
For J = 10 To 190 Step 10
N = N + 1
Shapes(CB(1, N)).Name = "Check Box " & (J + I)
Next J
Next I

End Sub

-------------------

 

[Peter T]

Hi Leith,

I'm afraid I had a few problems with your suggestion, starting the Shape
needs to be qualified, in this case with the sheet (but why not work with
the Checkboxes collection).

For i = 0 To 8
For j = 10 To 190 Step 10

- this adds up to 171, not 180

In a quick glance your sort routine appears to sort in column order then by
row, rather than by row then column. Also, because sort is on the string
address, row 32 would get sorted before row 8, eg

MsgBox "$C$8" > "$C$32" ' true ??

It will be easier to see if you change the caption to the new name. In your
routine change:

Shapes(CB(1, N)).Name = "Check Box " & (J + I)
to
With ActiveSheet.Shapes(CB(1, N))
.Name = "NewChBox " & (J + I)
.DrawingObject.Caption = .Name
End With

There can be problems renaming shapes with duplicate default type names, eg
"Check Box 1", so best not.

Try the routine I posted to add 20x9 checkboxes, CBgrid(), then mess it up
manually (but maintain exact 20x9 grid) or with something like this:

Sub MessUp_CBgrid()
' interchange top two rows and left two columns

Columns("E:F").Cut
Columns("C").Insert Shift:=xlToRight

Rows("4:5").Cut
Rows("2:3").Insert Shift:=xlDown
Application.CutCopyMode = False

End Sub

Following attempts to put my messed up 20x9 grid back together again -

Sub RearrangeCBs()
Dim n As Long, r As Long, c As Long
Dim ch As CheckBox
Dim cel As Range
Dim ws As Worksheet
Set ws = ActiveSheet
' Assumes 180 checkboxes exist in 20 row x 9 col grid
' and each row is in SAME sheet row

ReDim aloc(1 To ws.CheckBoxes.Count, 0 To 1)
ReDim aLink(1 To UBound(aloc))
For Each ch In ws.CheckBoxes
n = n + 1
With ch.TopLeftCell
aloc(n, 0) = Val(Format(.Column, .Row & "000"))
aloc(n, 1) = n
End With
aLink(n) = ch.LinkedCell
Next

fncSort aloc

If UBound(aloc) = 180 Then
n = 0
For r = 10 To 200 Step 10
For c = 0 To 8
n = n + 1
With ws.CheckBoxes(aloc(n, 1))
.Name = "Checkbox " & (r + c)
.Caption = .Name
.LinkedCell = aLink(n) ' *
End With
Next
Next
End If

' * might not be appropriate for the OP's scenario
End Sub

Sub fncSort(ar())
Dim i As Long, j As Long
Dim tmp(0 To 1)

For i = LBound(ar) To UBound(ar) - 1
For j = i + 1 To UBound(ar)
If ar(i, 0) > ar(j, 0) Then
tmp(0) = ar(j, 0): tmp(1) = ar(j, 1)
ar(j, 0) = ar(i, 0): ar(j, 1) = ar(i, 1)
ar(i, 0) = tmp(0): ar(i, 1) = tmp(1)
End If
Next j
Next i

End Sub

Regards,
Peter T