Search Contextures Sites

Survey Template With Option Buttons

Thanks to Dave Peterson, who wrote this technique.

To create an Excel survey template, you can use the Options Button controls from the Forms toolbar. You could create this template 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 template, 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.

Click here to download the zipped sample survey template

11-Oct-06: Click here to download a variation of the survey template, with response values of 0-4, and an N/A response 

 

Create the Excel Survey Template

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

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

 
   

Data Entry Forms Tutorials

1. Survey Form with Option Buttons
2. Data Entry Worksheet Form
3. Print Selected Items in Order Form
4. Data Entry and Update Form

 

Privacy Policy

 

Contextures Inc., Copyright ©2013
All rights reserved.

 

Last updated: May 30, 2013 3:32 PM