Automate adding radio buttons ?

staticbob

staticbob

Well-known Member
Joined
Oct 7, 2003
Messages
1,079
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
ABCDEFGHI
1Section A - COMPLETION CERTIFICATESRequiredEnclosedTo Follow
2
3
4
5Certificate of Practical Completion
6
7Certificate of Building Regulations Compliance
8
9
10Section B - BUILDING INFORMATION
11
12
13
14Drawing Register of all as built drawings
15
16Copies of all as built drawings
17
18Schedule of principle materials used in construction
19
Sheet1
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
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,
 
Upvote 0
Oops! :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!
 
Upvote 0
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
 
Upvote 0
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!
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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)
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question Question
VBA with a button to add a row to a table and insert data
Replies
3
Views
695
igold
igold
ChrisMac1
  • Question Question
VBA - Compare specific data in one column on one sheet, with the same column on 4 other sheets, copy specific cells if match found.
Replies
1
Views
390
ChrisMac1
ChrisMac1
I
  • Question Question
Move multiple rows from one table to another using conditional trigger
Replies
2
Views
892
ItsNursinTime
I
I
  • Question Question
Advice / Suggestion for what to do if two customers have the same name when adding to my worksheet.
Replies
4
Views
230
ipbr21054
I
D
  • Question Question
Tally that shifts cells daily.
Replies
3
Views
789
portews
P

Forum statistics

Threads
1,223,912
Messages
6,175,348
Members
452,638
Latest member
Oluwabukunmi

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top