Excel -- Survey Form With Option Buttons

Thanks to Dave Peterson, who wrote this technique.

To create a survey form, you can use the Options Button controls from the Forms toolbar. You could create this form manually, adding and aligning the option buttons. Or, use the following code, to add the text, option buttons, and formulas.

Run this code in an empty workbook, and it will create the number of questions and option buttons that you specify, using the maxBtns and NumberOfQuestions variables.

After running the code, you can add formatting and heading text to the survey worksheet, if you'd like. Weighting in column B can be changed from 1 to any value. Survey total is shown in cell A1.

After selecting an option, you can delete the score in column C for that row, to clear the selected option.

The zipped sample workbook can be downloaded here: SurveyForm.zip

11-Oct-06: A variation, with response values of 0-4, and an N/A response, can be downloaded here: SurveyForm02.zip 

 

Create the Survey Form

Run the following code once, to create the survey form. 

Sub SetupSurveyForm()
'code written by Dave Peterson 2005-10-27
'creates a survey form with option buttons
'http://www.contextures.com/xlForm01.html
  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 = 5
  NumberOfQuestions = 10

  Set wks = ActiveSheet
  With wks
    Set FirstOptBtnCell = .Range("e2")
    .Range("a:i").Clear
    With FirstOptBtnCell.Offset(-1, -1).Resize(1, maxBtns + 1)
        .Value = Array("Question#", "Resp1", "Resp2", _
                                   "Resp3", "Resp4", "Resp5")
        .Orientation = 90
        .HorizontalAlignment = xlCenter
    End With

    Set myRange = FirstOptBtnCell.Resize(NumberOfQuestions, 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.EntireRow.RowHeight = 28
    myRange.Resize(, maxBtns).EntireColumn.ColumnWidth = 4

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

  End With

  For Each myCell In myRange
    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
      With myCell.Offset(0, iCtr)
        Set optBtn = wks.OptionButtons.Add _
              (Top:=.Top, Left:=.Left, Height:=.Height, _
               Width:=.Width)
        optBtn.Caption = ""
        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

 
1. Forms -- Survey Form with Option Buttons
2. Forms -- Worksheet Data Entry Form
3. Forms -- Print Selected Items in Order Form
       Home     Excel Tips     Excel Files      Blog    Contact

 

RSS Feed

 

 

 

The Excel Store

Last updated: July 18, 2008 11:38 PM