Automatic coding in Excel for SPSS

[jlmkhrt]

My problem:

I have a large excel sheet containing responses from on online survey. The online survey system exports in mainly string form with each answer being in its own column.

I already have an SPSS data input set up with particular variables which already has entries. So I am unable to make SPSS variables match Excel.

Once solution I have is to write a macro for each individual replacement, approx 200 different options available.

Sub rep()
Dim rng As Range
Set rng = Worksheets("sheet1").Range("B2:B1000") 
Set rng1 = Worksheets("sheet1").Range("C2:C1000")
rng.Replace What:="Yes", Replacement:="1", Lookat:=xlWhole
rng.Replace What:="No", Replacement:="2", Lookat:=xlWhole
rng1.replace what:="Yes", Replacement:="1", Lookat:=xlWhole
rng1.Replace What:="No", Replacement:="2", Lookat:=xlWhole
End Sub

Is there another more efficient option?

 

[mrmmickle1]

Maybe something like this:

[COLOR=#0000ff]Sub[/COLOR] ReplaceValues()

  [COLOR=#0000ff]  Dim[/COLOR] vFindText   [COLOR=#0000ff] As Variant[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] vRplText     [COLOR=#0000ff]As Variant[/COLOR]
[COLOR=#0000ff]    Dim[/COLOR] Lastrow      [COLOR=#0000ff]As Long[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] i           [COLOR=#0000ff] As Long[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] Rng          As Range
    
    Lastrow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  [COLOR=#0000ff]  Set [/COLOR]Rng = Range("B2:C" & Lastrow)
    vFindText = Array("Yes", "No")
    vRplText = Array("1", "2")
  [COLOR=#0000ff]  For[/COLOR] i = [COLOR=#0000ff]LBound[/COLOR](vFindText) [COLOR=#0000ff]To UBound[/COLOR](vFindText)
    Rng.Replace vFindText(i), vRplText(i)
   [COLOR=#0000ff] Next[/COLOR] i

[COLOR=#0000ff]End Sub[/COLOR]

Note that the arrays will need to match up like this with Words and there Replacements:

vFindText = Array("[B][COLOR=#ff0000]Word1[/COLOR][/B]", "[B][COLOR=#0000ff]Word2[/COLOR][/B]", "[B][COLOR=#008000]Word3[/COLOR][/B]", "[B][COLOR=#000080]Word4[/COLOR][/B]")
vRplText = Array("[B][COLOR=#ff0000]Replacement1[/COLOR][/B]", "[B][COLOR=#0000ff]Replacement2[/COLOR][/B]", "[B][COLOR=#008000]Replacement3[/COLOR][/B]", "[B][COLOR=#000080]Replacement4[/COLOR][/B]")

 

[jlmkhrt]

Thank you.

One question. Not all the columns contain yes or no. There are additional survey responses in some columns which have to be coded. Will I just have to use the code you suggested, but with the different replacement values for those columns.?

 

[mrmmickle1]

jlmkhrt,


I think this may help with your inquiry. With other "text values" you would do something like this:

[COLOR=#0000ff]Sub[/COLOR] ReplaceValues()


[COLOR=#0000ff]    Dim[/COLOR] vFindText   [COLOR=#0000ff] As Variant[/COLOR]
  [COLOR=#0000ff]  Dim[/COLOR] vRplText     [COLOR=#0000ff]As Variant[/COLOR]
[COLOR=#0000ff]    Dim[/COLOR] Lastrow      [COLOR=#0000ff]As Long[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] i            [COLOR=#0000ff]As Long[/COLOR]
 [COLOR=#0000ff]   Dim[/COLOR] Rng          [COLOR=#0000ff]As [/COLOR]Range
    
    Lastrow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row [COLOR=#008000]'Defines LastRow[/COLOR]
    [COLOR=#0000ff]Set[/COLOR] Rng = Range("B2:C" & Lastrow) [COLOR=#008000]'Range the replacements occur.  Change Range As Necessary[/COLOR]
    vFindText = Array([COLOR=#ff0000]"Yes", "No", "Meets Expectations", "Exceeds Expectations", "Greatly Exceeds Expectations"[/COLOR]) [COLOR=#008000]'Find these Words[/COLOR]
    vRplText = Array([COLOR=#ff0000]"1", "2", "3", "4", "5"[/COLOR]) [COLOR=#008000]'Replace the found words with these words[/COLOR]
    [COLOR=#0000ff]For[/COLOR] i = [COLOR=#0000ff]LBound[/COLOR](vFindText) [COLOR=#0000ff]To UBound[/COLOR](vFindText)
    Rng.Replace vFindText(i), vRplText(i)
   [COLOR=#0000ff] Next[/COLOR] i


[COLOR=#0000ff]End Sub[/COLOR]

 

[jlmkhrt]

Thanks again.

I did understand that I could add additional items to the find, and so long as they are in the same order, the replace.

I still have one more problem, sorry...

In column 1 (for example) I was Yes to be 1 and No to be 2.
In column 2: Male to be 1, female to be 2

I have about 120 columns so if there was an easier way than just using the same code copied for each column then that would be amazing!

 

[mrmmickle1]

jlmkhrt,

Try something like this:

[COLOR=#0000ff]Sub[/COLOR] ReplaceValues()


  [COLOR=#0000ff]  Dim [/COLOR]vFindText    [COLOR=#0000ff]As Variant[/COLOR]
 [COLOR=#0000ff]   Dim [/COLOR]vRplText    [COLOR=#0000ff] As Variant[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] Lastrow     [COLOR=#0000ff] As Long[/COLOR]
  [COLOR=#0000ff]  Dim[/COLOR] i           [COLOR=#0000ff] As Long[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] Rng         [COLOR=#0000ff] As [/COLOR]Range
   [COLOR=#0000ff] Dim[/COLOR] b           [COLOR=#0000ff] As Integer[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] Col          [COLOR=#0000ff]As Variant[/COLOR]

    Lastrow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row 'Define LastRow


   [COLOR=#0000ff] For[/COLOR] b = 1 [COLOR=#0000ff]To[/COLOR] 2 [COLOR=#0000ff]Step [/COLOR]1 [COLOR=#008000]'Change Column # accordingly.... 120 in your case[/COLOR]
    
       [COLOR=#0000ff] Set[/COLOR] Rng = Range(Cells(1, b), Cells(Lastrow, b))[COLOR=#008000] 'Range the replacements occur.  Change Range As Necessary[/COLOR]
        
        Rng.Select [COLOR=#008000]'Select Range[/COLOR]
        Col = Split(ActiveCell(1).Address(1, 0), "$")(0)  [COLOR=#008000]'Get Column Letter[/COLOR]
        
           [COLOR=#0000ff] Select Case[/COLOR] Col
                  [COLOR=#0000ff] Case[/COLOR] "A":
                   vFindText = Array("Yes", "No") [COLOR=#008000]'Find these Words[/COLOR]
                   vRplText = Array("2", "1") [COLOR=#008000]'Replace the found words with these words[/COLOR]
                  [COLOR=#0000ff] Case[/COLOR] "B":
                   vFindText = Array("Female", "Male") [COLOR=#ff0000]'Be careful about the order see below code window for notes[/COLOR]
                   vRplText = Array("2", "1") 
                   [COLOR=#0000ff]Case Else[/COLOR]:
[COLOR=#0000ff]                   Exit Sub[/COLOR]
[COLOR=#0000ff]            End Select[/COLOR]

[COLOR=#0000ff]        For[/COLOR] i = [COLOR=#0000ff]LBound[/COLOR](vFindText) [COLOR=#0000ff]To[/COLOR] [COLOR=#0000ff]UBound[/COLOR](vFindText)
        Rng.Replace vFindText(i), vRplText(i)
        
       [COLOR=#0000ff] Next [/COLOR]i

[COLOR=#0000ff]    Next[/COLOR] b
[COLOR=#0000ff]
[/COLOR]
[COLOR=#0000ff]End Sub[/COLOR]

If you have alot of columns with the same "rules" you can use a case like this:

[COLOR=#0000ff]Case[/COLOR] "A", "B", "C", "D", "E":
vFindText = Array("Female", "Male")
vRplText = Array("1", "2")

NOTES:

If you were to use this code:

[COLOR=#0000FF]Case[/COLOR] "B":
vFindText = Array("Male", "Female") 
vRplText = Array("1", "2")

You would end up replacing the "male" portion of Female leaving you with values like this: Fe1 etc.... So larger words that contain smaller words would need to be replaced first as in the above code.