Automate adding radio buttons ?

staticbob · Nov 3, 2004

Guys,

Would it be possible to automate adding radio buttons to each row on this sheet ? I have 400 rows !!! Column D needs a check box in for each item, columns F & H should be mutually exclusive radio buttons.

Any ideas ??????

Thanks
Bob

handover.xls

A

B

C

D

E

F

G

H

I

1

Section A - COMPLETION CERTIFICATES

Required

Enclosed

To Follow

2

3

4

5

Certificate of Practical Completion

6

7

Certificate of Building Regulations Compliance

8

9

10

Section B - BUILDING INFORMATION

11

12

13

14

Drawing Register of all as built drawings

15

16

Copies of all as built drawings

17

18

Schedule of principle materials used in construction

19

Sheet1

Andrew Poulsom · Nov 3, 2004

What determines which rows contain the Controls? Borders? What's the format of those in VBA speak?

Ken Puls · Nov 3, 2004

Hi StaticBob,

How about something like this?

Code:

Sub MakeCheckBoxes()
Dim cl As Range, oOLE As OLEObject

For Each cl In ActiveSheet.Range("B1:B" & ActiveSheet.Range("B65536").End(xlUp).Row)
    If Left(cl, 7) = "Section" Then
        'do nothing
    ElseIf cl.Value = "" Then
        'do nothing
    Else
        'Add checkbox to Column D
        Set oOLE = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=cl.Offset(0, 2).Left, Top:=cl.Offset(0, 2).Top, _
            Width:=cl.Offset(0, 2).Width, Height:=cl.Offset(0, 2).Height)
        With oOLE
            .Object.Caption = ""
        End With
        
        'Add checkbox to Column F
        Set oOLE = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=cl.Offset(0, 4).Left, Top:=cl.Offset(0, 4).Top, _
            Width:=cl.Offset(0, 4).Width, Height:=cl.Offset(0, 4).Height)
        With oOLE
            .Object.Caption = ""
        End With
        
        'Add checkbox to Column H
        Set oOLE = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=cl.Offset(0, 6).Left, Top:=cl.Offset(0, 6).Top, _
            Width:=cl.Offset(0, 6).Width, Height:=cl.Offset(0, 6).Height)
        With oOLE
            .Object.Caption = ""
        End With
    End If
Next cl
End Sub

It will put a checkbox in each of your three columns, for each item that does not have a blank entry or start with "Section" in column B. These checkboxes will also be sized to fit the cell exactly, and have been made so that only the checkbox (no text) shows.

And it will also run for as many rows as you have in the sheet. Save you're workbook before running it though! (That way you can just quit without saving to discard the changes.) If you do end up needing a routine to delete all of them at some point (like you've added rows and want to re-run it), post back.

Cheers,

Ken Puls · Nov 3, 2004

Oops!

I just re-read your post, and realized that you didn't want checkboxes in the last two columns...

Try this instead for the checkbox in the column D, and OptionButtons in Columns F&H, which react to each other

Code:

Sub MakeOLEObjects()
Dim cl As Range, oOLE As OLEObject

For Each cl In ActiveSheet.Range("B1:B" & ActiveSheet.Range("B65536").End(xlUp).Row)
    If Left(cl, 7) = "Section" Then
        'do nothing
    ElseIf cl.Value = "" Then
        'do nothing
    Else
        'Add checkbox to Column D
        Set oOLE = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=cl.Offset(0, 2).Left, Top:=cl.Offset(0, 2).Top, _
            Width:=cl.Offset(0, 2).Width, Height:=cl.Offset(0, 2).Height)
        With oOLE
            .Object.Caption = ""
        End With
        
        'Add OptionButton to Column F
        Set oOLE = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Optionbutton.1", Link:=False, _
        DisplayAsIcon:=False, Left:=cl.Offset(0, 4).Left, Top:=cl.Offset(0, 4).Top, _
            Width:=cl.Offset(0, 4).Width, Height:=cl.Offset(0, 4).Height)
        With oOLE
            .Object.Caption = ""
            .Object.GroupName = cl.Row
        End With
        
        'Add OptionButton to Column H
        Set oOLE = ActiveSheet.OLEObjects.Add(ClassType:="Forms.optionbutton.1", Link:=False, _
        DisplayAsIcon:=False, Left:=cl.Offset(0, 6).Left, Top:=cl.Offset(0, 6).Top, _
            Width:=cl.Offset(0, 6).Width, Height:=cl.Offset(0, 6).Height)
        With oOLE
            .Object.Caption = ""
            .Object.GroupName = cl.Row
        End With
    End If
Next cl
End Sub

And also, just in case you need it, the following is the code to delete all the OLEObjects from your worksheet. (Be warned though, it gets 'em all, not just ones created by this procedure.)

Code:

Sub DeleteOLEObjects()
'Delete ALL OLEObjects from active worksheet
Dim oOLE As OLEObject

For Each oOLE In ActiveSheet.OLEObjects
    oOLE.Delete
Next oOLE
    
End Sub

Sorry 'bout that. Hope it helps!

staticbob · Nov 4, 2004

Thanks Ken,

That works like a dream !

Just a couple of questons.

1) Is there anyway to get these controls centre alinged in the cells ? In the properties of the control I can only choose left or right, is there anything that I'm missing ?

2) Is there anyway I can make all of these checkboxes then add code to untick column F if column H is ticked and vise verca ??? I assume this won't be easy without naming the controls so we have something to reference.

Thanks again !
Bob

Ken Puls · Nov 4, 2004

Hi Bob,

As far as centering, nothing I could find, but I did change the code to start in the centre of the column and make the checkbox & option buttons a bit smaller. With regards to unchecking the F column if H is checked (option buttons) it should be doing that. (The reason for the "groupname" property.)

I have also changed the code a bit, though, to give each set names like this:
Checkbox for a row = cb & rownumber (cb5, cb7, etc...)
OptionButtons are obF & rownumber, obH & rownumber

So for row 5, you'll end up with cb5, obF5, and obH5

This allowed me to attempt (see further on below) to automate creating a procedure like the following which will clear the option button set if the checkbox is unchecked. It goes in the worksheet module for whatever sheet contains your buttons.

Code:

Private Sub cb5_Click()
   If Me.cb5.Value = False Then
       Me.obF5.Value = False
       Me.obH5.Value = False
   End If
End Sub

So here's the rewritten procedure:

Code:

Sub MakeOLEObjects()
Dim cl As Range, oole As OLEObject

For Each cl In ActiveSheet.Range("B1:B" & ActiveSheet.Range("B65536").End(xlUp).Row)
    If Left(cl, 7) = "Section" Then
        'do nothing
    ElseIf cl.Value = "" Then
        'do nothing
    Else
        'Add checkbox to Column D
        Set oole = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
            Link:=False, DisplayAsIcon:=False, _
            Left:=cl.Offset(0, 2).Left + (cl.Offset(0, 3).Left - cl.Offset(0, 2).Left) / 2, _
            Top:=cl.Offset(0, 2).Top, _
            Width:=cl.Offset(0, 2).Width - (cl.Offset(0, 3).Left - cl.Offset(0, 2).Left) / 2, _
            Height:=cl.Offset(0, 2).Height)
        With oole
            .Object.Caption = ""
            .Object.GroupName = cl.Row
            .Name = "cb" & cl.Row
        End With
        
        'Add OptionButton to Column F
        Set oole = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Optionbutton.1", _
            Link:=False, DisplayAsIcon:=False, _
            Left:=cl.Offset(0, 4).Left + (cl.Offset(0, 5).Left - cl.Offset(0, 4).Left) / 2, _
            Top:=cl.Offset(0, 4).Top, _
            Width:=cl.Offset(0, 4).Width - (cl.Offset(0, 5).Left - cl.Offset(0, 4).Left) / 2, _
            Height:=cl.Offset(0, 4).Height)
        With oole
            .Object.Caption = ""
            .Object.GroupName = cl.Row
            .Name = "obF" & cl.Row
        End With
        
        'Add OptionButton to Column H
        Set oole = ActiveSheet.OLEObjects.Add(ClassType:="Forms.optionbutton.1", _
            Link:=False, DisplayAsIcon:=False, _
            Left:=cl.Offset(0, 6).Left + (cl.Offset(0, 7).Left - cl.Offset(0, 6).Left) / 2, _
            Top:=cl.Offset(0, 6).Top, _
            Width:=cl.Offset(0, 6).Width - (cl.Offset(0, 7).Left - cl.Offset(0, 6).Left) / 2, _
            Height:=cl.Offset(0, 6).Height)
        With oole
            .Object.Caption = ""
            .Object.GroupName = cl.Row
            .Name = "obH" & cl.Row
        End With
        
    End If
Next cl
End Sub

Now to the problem part. I'm a little stumped on this, so if anyone else can shed some light, I'd appreciate it. Based on an example from Chip Pearson (I think) I have the code below to automatically add the code for each checkbox as shown above. (It should automatically change the numbers to match the rows, and goes in a regular module.) I originally started with it as part of the redone macro above, but it kept bombing after creating the first set of OLEObjects (checkbox, two option buttons and the code for them). Even after separating, it still kills Excel (so I know it is the problem code.) I can't even debug it, as it keeps telling me that I "cannot enter break mode at this time." I'm posting the procedure in hopes that it will run okay on your machine, or so that someone can point out a flaw...

Code:

Sub AddCode()
Dim LineNum As Long, cl As Range

    For Each cl In ActiveSheet.Range("B1:B" & ActiveSheet.Range("B65536").End(xlUp).Row)
        If Left(cl, 7) = "Section" Then
            'do nothing
        ElseIf cl.Value = "" Then
            'do nothing
        Else
            With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
                LineNum = .CountOfLines
                .InsertLines LineNum, "Private Sub cb" & cl.Row & "_Click()" & vbLf & _
                "   If Me.cb" & cl.Row & ".Value = False Then" & vbLf & _
                "       Me.obF" & cl.Row & ".Value = False" & vbLf & _
                "       Me.obH" & cl.Row & ".Value = False" & vbLf & _
                "   End If " & vbLf & _
                "End Sub"
            End With
        End If
    Next cl
End Sub

As eluded to above, this procedure really should be incorporated into the main one, not done separately, as the loopn through all cells really slows things down.

I'd like to know if it works for anyone else out there, as it looks to me like it should run!

staticbob · Nov 5, 2004

Sorry Ken,

I don't think I made myself clear. Although the Radio buttons are easily made mutually exclusive, my user doesn't like them !!!!!!!!!!!!! Is there anyway we can take your original post, adding check boxes not optionbuttons to all 3 columns, then make the last 2 columns mutually exclusive checkboxes.

I think creating the checkboxes is easy, its just adding the code to each row to make columns F and H single select that seems difficult, as you have mentioned. I will try to run your code example later today and see what happens.

Is there anyway to just reference these controls by the column they anchor to, rather than an individual row reference ? So we could then just say if control in column F is true, then corrisponding control in H is false and vise verca. Hmmmmmm, not that easy I fear.

Thanks again for the help, I will let you know how I get on testing later.

Bob

Andrew Poulsom · Nov 5, 2004

Try this:

Code:

Sub MakeOLEObjects()
Dim cl As Range, oole As OLEObject

For Each cl In ActiveSheet.Range("B1:B" & ActiveSheet.Range("B65536").End(xlUp).Row)
    If Left(cl, 7) = "Section" Then
        'do nothing
    ElseIf cl.Value = "" Then
        'do nothing
    Else
        'Add checkbox to Column D
        Set oole = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
            Link:=False, DisplayAsIcon:=False, _
            Left:=cl.Offset(0, 2).Left + (cl.Offset(0, 3).Left - cl.Offset(0, 2).Left) / 2, _
            Top:=cl.Offset(0, 2).Top, _
            Width:=cl.Offset(0, 2).Width - (cl.Offset(0, 3).Left - cl.Offset(0, 2).Left) / 2, _
            Height:=cl.Offset(0, 2).Height)
        With oole
            .Object.Caption = ""
            .Name = "cbD" & cl.Row
        End With
        
        'Add checkbox to Column F
        Set oole = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
            Link:=False, DisplayAsIcon:=False, _
            Left:=cl.Offset(0, 4).Left + (cl.Offset(0, 5).Left - cl.Offset(0, 4).Left) / 2, _
            Top:=cl.Offset(0, 4).Top, _
            Width:=cl.Offset(0, 4).Width - (cl.Offset(0, 5).Left - cl.Offset(0, 4).Left) / 2, _
            Height:=cl.Offset(0, 4).Height)
        With oole
            .Object.Caption = ""
            .Name = "cbF" & cl.Row
        End With
        
        'Add checkbox to Column H
        Set oole = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
            Link:=False, DisplayAsIcon:=False, _
            Left:=cl.Offset(0, 6).Left + (cl.Offset(0, 7).Left - cl.Offset(0, 6).Left) / 2, _
            Top:=cl.Offset(0, 6).Top, _
            Width:=cl.Offset(0, 6).Width - (cl.Offset(0, 7).Left - cl.Offset(0, 6).Left) / 2, _
            Height:=cl.Offset(0, 6).Height)
        With oole
            .Object.Caption = ""
            .Name = "cbH" & cl.Row
        End With
        
    End If
Next cl
End Sub

Sub AddCode()
    Dim CodeMod As Object
    Dim oole As OLEObject
    Dim cbFName As String
    Dim cbHName As String
    Dim Code As String
    Dim Line As Integer
    Set CodeMod = ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    For Each oole In ActiveSheet.OLEObjects
        If Left(oole.Name, 3) = "cbF" Then
            cbFName = oole.Name
            cbHName = WorksheetFunction.Substitute(cbFName, "cbF", "cbH")
            With CodeMod
                Line = .CreateEventProc("Click", cbFName) + 1
                Code = "   If " & cbFName & ".Value = True Then" & vbCrLf
                Code = Code & "       " & cbHName & ".Value = False" & vbCrLf
                Code = Code & "   End If"
                .InsertLines Line, Code
                Line = .CreateEventProc("Click", cbHName) + 1
                Code = "   If " & cbHName & ".Value = True Then" & vbCrLf
                Code = Code & "       " & cbFName & ".Value = False" & vbCrLf
                Code = Code & "   End If"
                .InsertLines Line, Code
            End With
        End If
    Next oole
    AppActivate Application.Caption
End Sub

staticbob · Nov 5, 2004

Andrew,

Thats almost perfect ! Just one cosmetic thing that would be nice to sort if poss.

My row height is 18pnt. My cells with the check boxes in have a bold border set on them. How can I make these controls have a height of 10. If I change this in the properties it sits OK in the cell.

Thanks
Bob

Andrew Poulsom · Nov 5, 2004

In the code instead of eg

Code:

            Set oole = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _ 
            Link:=False, DisplayAsIcon:=False, _ 
            Left:=cl.Offset(0, 2).Left + (cl.Offset(0, 3).Left - cl.Offset(0, 2).Left) / 2, _ 
            Top:=cl.Offset(0, 2).Top, _ 
            Width:=cl.Offset(0, 2).Width - (cl.Offset(0, 3).Left - cl.Offset(0, 2).Left) / 2, _ 
            Height:=cl.Offset(0, 2).Height)

try:

Code:

            Set oole = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _ 
            Link:=False, DisplayAsIcon:=False, _ 
            Left:=cl.Offset(0, 2).Left + (cl.Offset(0, 3).Left - cl.Offset(0, 2).Left) / 2, _ 
            Top:=cl.Offset(0, 2).Top + 4, _ 
            Width:=cl.Offset(0, 2).Width - (cl.Offset(0, 3).Left - cl.Offset(0, 2).Left) / 2, _ 
            Height:=10)

Automate adding radio buttons ?

staticbob

Well-known Member

Excel Facts

Andrew Poulsom

MrExcel MVP

Ken Puls

Active Member

Ken Puls

Active Member

staticbob

Well-known Member

Ken Puls

Active Member

staticbob

Well-known Member

Andrew Poulsom

MrExcel MVP

staticbob

Well-known Member

Andrew Poulsom

MrExcel MVP

Similar threads

Forum statistics

Share this page

Automate adding radio buttons ?

Well-known Member

Excel Facts

MrExcel MVP

Active Member

Active Member

Well-known Member

Active Member

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock