Create survey

[KeiSan]

Hello everyone,


I searched the Forum for a specific kind of survey, but I could no
really find the perfect answer (yet )

I would like to create a survey with 7 questions and a tick box with
answer possibilities (which are weighted from 0 to 3) and calculate th
average outcome.
I found this one: http://www.contextures.com/xlForm01.html
which mainly does what I want (just weighting only from 1, but I thin
with some mesing arounf in the final calculation this wil be fine)

Now I would like to
a) create something like a "pop-up" window with the final score and som
text (explanation of the score) and
b) save the outcome and a participant number in an excel file and
c) "reset" the survey so that the next participant can do it

Thanks a lot

 

[benmcclave]

Hi KeiSan,

The code below should do the trick (after you customize it for your needs).Once your userform calculates a score, have the form call this procedure and feed the score to it. The procedure will display a customized message and then save data that you specify to a location in your workbook. Finally, unloading the form will clear the entries and let the next user complete it from scratch. Hope this helps.

-Ben

Sub ReportResults(dScore As Double)
'Userform will calculate score and then call this procedure
'to generate a messagebox with your customized message
'
'Message will vary based upon score ranges
'Customize your ranges and messages below

Select Case dScore

Case Is <= 5
MsgBox "Your score is " & Format(dScore, "0.00") & "." & vbCr & vbCr & _
"Here is your explanation.", , "Results"

Case Is <= 10
MsgBox "Your score is " & Format(dScore, "0.00") & "." & vbCr & vbCr & _
"Here is your explanation.", , "Results"

Case Else
MsgBox "Your score is " & Format(dScore, "0.00") & "." & vbCr & vbCr & _
"Here is your explanation.", , "Results"

End Select

'Now, the code will save data to a place in your spreadsheet
'In this example, it will find the next available row in column A
'on Sheet1 and plug in the username, score and date/time
'
'You may customize the tracking information if you want
'to track something different
With Sheet1.Range("A50000").End(xlUp)
.Offset(1, 0).Value = Environ("Username")
.Offset(1, 1).Value = dScore
.Offset(1, 2).Value = Now()
End With

'Optional: uncomment below to unload the userform
'Unload UserForm1
End Sub