Code help for Option Group (Excel 2000)

Topic

New Reply

I found some code on the web to create a survey form.
I modified it to create the option group that I want. In this case it makes a group in 3 rows
The problem is that instead of the group in each row linking to the cell next to it, they all link to the same cell
and the totals accumulate.

Sub SetupSurveyForm()
'code written by Dave Peterson 2005-10-27
'creates a survey form with option buttons
  Dim grpBox As GroupBox
  Dim optBtn As OptionButton
  Dim maxBtns As Long
  Dim myCell As Range
  Dim myRange As Range
  Dim wks As Worksheet
  Dim iCtr As Long
  Dim FirstOptBtnCell As Range
  Dim NumberOfQuestions As Long

 ' Dim myBorders As Variant

'  myBorders = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, _
                           xlInsideVertical, xlInsideHorizontal)

  maxBtns = 3
  NumberOfQuestions = 3

  Set wks = ActiveSheet
  With wks
    Set FirstOptBtnCell = .Range("c2")
    .Range("a:i").Clear
   ' With FirstOptBtnCell.Offset(-1, -1).Resize(1, maxBtns + 1)
   '     .Value = Array("q", "Sales", "Service", "Sales Engineer")
   '     .Orientation = 90
   '     .HorizontalAlignment = xlCenter
   ' End With

    Set myRange = FirstOptBtnCell.Resize(NumberOfQuestions, 1) 'c2:questions + 1

 '   With myRange.Offset(0, -1)
 '       .Formula = "=row()-" & myRange.Row - 1
 '       .Value = .Value
 '   End With

 '   myRange.Offset(0, -3).Value = 1

    'With myRange.Offset(0, -4)
    '  .FormulaR1C1 = "=rc[1]*rc[2]"
    'End With

    '.Range("a1").Formula = "=sum(A2:A" & NumberOfQuestions + 1 & ")"

   ' With myRange.Offset(0, -4).Resize(, 4)
   '   For iCtr = LBound(myBorders) To UBound(myBorders)
   '     With .Borders(myBorders(iCtr))
   '       .LineStyle = xlContinuous
   '       .Weight = xlThin
   '       .ColorIndex = xlAutomatic
   '     End With
   '   Next iCtr
   '   .HorizontalAlignment = xlCenter
   '   .VerticalAlignment = xlCenter
   ' End With
'myRange.Activate
    myRange.EntireRow.RowHeight = 28
    'myRange.Resize(, maxBtns).EntireColumn.ColumnWidth = 4
    myRange.EntireColumn.ColumnWidth = 32

    'clean up existing junk
    .GroupBoxes.Delete
    .OptionButtons.Delete

  End With

  For Each myCell In myRange
    'With myCell.Resize(1, maxBtns)
    With myCell '.Resize(1, maxBtns)
      Set grpBox = wks.GroupBoxes.Add(Top:=.Top, Left:=.Left, _
      Height:=.Height, Width:=.Width)
      With grpBox
        .Caption = ""
        .Visible = True 'False
      End With
    End With
    For iCtr = 0 To maxBtns - 1 'create buttons
      'With myCell.Offset(0, iCtr)
      With myCell '.Offset(0, iCtr)
            Select Case iCtr
                Case 0
                    Set optBtn = wks.OptionButtons.Add(Top:=.Top, Left:=94, _
                                           Height:=.Height, Width:=.Width)
                Case 1
                    Set optBtn = wks.OptionButtons.Add(Top:=.Top, Left:=140, _
                                           Height:=.Height, Width:=.Width)
                Case 2
                    Set optBtn = wks.OptionButtons.Add(Top:=.Top, Left:=190, _
                                           Height:=.Height, Width:=.Width)
            End Select
            Select Case iCtr
                Case 0
                    optBtn.Caption = "Sales"
                Case 1
                    optBtn.Caption = "Service"
                Case 2
                    optBtn.Caption = "Service Engineer"
            End Select
        If iCtr = 0 Then
          With myCell.Offset(0, -2)
            optBtn.LinkedCell = .Address(external:=True)
          End With
        End If
      End With
    Next iCtr
  Next myCell
End Sub

Running this code will create the option groups so you can see what I mean.
Can someone give me any ideas.
Thanks,
Scott

Reply | Quote

Replies

If you want the option buttons in one row to act as a group, you have to place a group box around them. All option buttons on a worksheet that are not placed in a group box, belong to the same group, and they share the same linked cell.

Reply | Quote

Hans,
In the code the the group box is created then the option buttons are placed in the box in each row.
Or thats what is seems to do. I can click on the box in each row and it has a different group box number.
But it still doesn’t act right.

Reply | Quote

Sorry, I didn’t look closely enough.

But the option buttons don’t fit entirely within the group boxes you create, that’s what causes it to fail. See attached demo, where the option buttons have been made smaller.

Reply | Quote

Thanks, I modified the Left, Height, Width parameters and that did it.
Thanks.

Reply | Quote