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
Contextures Inc., Copyright ©2013
All rights reserved.
Last updated: May 30, 2013 3:32 PM