Bulk update/recode of survey text responses to numerical values via a lookup table using macros

My objective is to build a macro either in Access or Excel to be able to convert standard text responses (strongly disagree, disagree, neutral, agree, strongly agree) into their equivalent numerical values (strongly disgree = 1, disagree = 2, neutral = 3, agree = 4, strongly agree = 5)

The source data is from Google survey, which generates these standard text responses on a 5-point scale.
Each survey response would contain around a 200+ unique responses to 30+ questions, most of which would require inputs in this 5-point scale format.

I thought a macro would be the way to go as it would be quite tedious to do a vlookup for each column of responses where there is this 5-point scale. However, I'm not sure if Excel or Access would be the best way to go about this. Greatly appreciate your expert thoughts and solutions!
Lynn LoiAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

do you have a sample data ?
Lynn LoiAuthor Commented:
Hi gowflow,

Thanks for your response. Pls find the sample data attached for reference.

ok please correct me if I am wrong.

You will have data in sheet SurveyData

and you want a macro that will build the sheet NewHeaders based on the info that exist in the other 2 sheets ?

One more thing Can you post more data so the macro that is built can be verified ?

Price Your IT Services for Profit

Managed service contracts are great - when they're making you money. Yes, you’re getting paid monthly, but is it actually profitable? Learn to calculate your hourly overhead burden so you can master your IT services pricing strategy.

Lynn LoiAuthor Commented:
To confirm:
- data is stored in the sheet SurveyData
- Yes, I wish to have a macro created to build the sheet NewHeaders based on the info that exist in the other 2 sheets, SurveyData and RecodeValues

Pls find the updated file with more data posted in the SurveyData sheet enclosed for your reference.

ok working on it no problem just give me sometime as hv to step out. Will b back asap.
ok here it is.

I have created a macro with a button in sheet SurveyData called Recode Survey. Please activate it and it will create a new sheet with today's date and time stamp and put the desired results.

You will notice that some survey results could not be found in the table the macro takes care of this and warn you to simply include them in the table and run the macro again and all will be converted fine.

This is the code for your reference

Sub RecodeSurvey()
Dim WSSurv As Worksheet
Dim WSRec As Worksheet
Dim WSRef As Worksheet
Dim WSNewHead As Worksheet
Dim MaxRowSurv As Long, MaxColSurv As Long, MaxRowRec As Long, I As Long, J As Long
Dim cCell As Range
Dim sSurvGrid As String
Dim lCount As Long

'---> Disable Events
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'---> Set Variables
Set WSSurv = Sheets("SurveyData")
MaxRowSurv = WSSurv.Range("A" & WSSurv.Rows.Count).End(xlUp).Row
MaxColSurv = WSSurv.Columns(WSSurv.Columns.Count).End(xlToLeft).Column
WSSurv.Copy after:=WSSurv
Set WSNewHead = ActiveSheet
WSNewHead.Name = "NewHeaders " & Format(Now, "mmddyy hhmm")
Set WSRec = Sheets("RecodeValues")
MaxRowRec = WSRec.Range("A" & WSRec.Rows.Count).End(xlUp).Row
Set WSRef = Sheets("ForReference")

'---> Replace row1 Questions
For I = 5 To MaxColSurv
    Set cCell = WSRef.UsedRange.Find(what:=WSNewHead.Cells(1, I), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
    If Not cCell Is Nothing Then
        WSNewHead.Cells(1, I) = cCell.Offset(, 1)
    End If
Next I

'---> Fill SurveyGrid with values
For I = 2 To MaxRowRec
    sSurvGrid = sSurvGrid & WSRec.Cells(I, "A") & WSRec.Cells(I, "B") & ";"
Next I

'---> Convert Survey Values to Numbers
For I = 2 To MaxRowSurv
    For J = 5 To MaxColSurv
        If Not IsNumeric(Mid(sSurvGrid, InStr(1, sSurvGrid, WSNewHead.Cells(I, J)) + Len(WSNewHead.Cells(I, J)), 1)) Then
            'MsgBox "Survey Labeling <" & WSNewHead.Cells(I, J) & "> not found in Table RecodeValues. Please ensure to include it and run the macro again for proper coding.", vbCritical, "Add Reference"
            lCount = lCount + 1
            WSNewHead.Cells(I, J) = Mid(sSurvGrid, InStr(1, sSurvGrid, WSNewHead.Cells(I, J)) + Len(WSNewHead.Cells(I, J)), 1)
        End If
    Next J
Next I

WSNewHead.Range("1:" & MaxRowSurv).EntireRow.AutoFit
WSNewHead.Range(WSNewHead.Columns(1), WSNewHead.Columns(MaxColSurv)).EntireColumn.AutoFit

'---> Enable Events
With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

If lCount = 0 Then
    MsgBox "All Survey Responses converted to numbers successfully.", vbInformation, "Recode Survey"
    MsgBox "There was " & lCount & " Survey Responses that were not found in Table RecodeValues. Original values have been kept in file. Please ensure proper code has been created in sheet RecodeValues and run the macro again.", vbInformation, "Recode Survey"
End If

End Sub

Open in new window

Attached is the workbook that contains the code. Please ensure to enable macros before running the macro.

Let me know your comments

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Lynn LoiAuthor Commented:
gowflow, thank you very much for your help! This solution worked perfectly!
Perfect !!!

I am glad it worked fine for you. Please do not hesitate to let me know in a message if you need help on any issue by posting a link.

Have a nice day
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.