Results 1 to 10 of 10

Thread: Extract, Transpose and Fill automation in a survey

  1. #1
    Junior Member
    Join Date
    Jan 2014
    Posts
    6
    Rep Power
    0

    Extract, Transpose and Fill automation in a survey

    Dear friends,
    With the help of fellow forum colleagues I managed to convert the output of a 300 people Google survey to something processable in Excel. Essentially, transforming the layout of the "per-row" output into a "per-column" table that I can Pivot or analyze afterwards.
    But I cannot complete a piece of the layout without your help.
    I've attached a sample of the survey (just 2 people/34 questions due to file size limits in this forum) and explained what I need within the spreadsheet.
    In a nutshell, I need to make 4 new columns, copy the values of the last 4 questions of each respondent to the corresponding column and fill the rest of the column down until the next respondent values begin.
    This is because this last four questions hold demographic data (Job post, Area, Years in the job, Comments) that I will need to group the respondent answers when I process them in a pivot table or statistical package.
    Attached Files Attached Files

  2. #2
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    Hi

    Welcome to board!!

    Insert a standard module and put the code there. Adjust the range wherever necessary.

    Code:
    Option Explicit
    
    Sub kTest()
        
        Dim Data, i As Long, n As Long, c As Long, dic As Object
        Dim arrOutput(), List, v, ShtOutput As Worksheet
        
        Set dic = CreateObject("scripting.dictionary")
            dic.comparemode = 1
        
        Data = Worksheets("form responses").Range("a1").CurrentRegion.Resize(, 35).Value2
        List = Worksheets("sheet2").Range("a7:g40").Value2 '<< adjust this range
        
        For i = 1 To UBound(List, 1)
            dic.Item(List(i, 1)) = Array(List(i, 7), List(i, 2))
        Next
        
        ReDim arrOutput(1 To UBound(Data, 2) * 34, 1 To 10)
        
        For i = 2 To UBound(Data, 1)
            For c = 2 To UBound(Data, 2) - 4
                n = n + 1
                arrOutput(n, 1) = Data(i, 1)
                arrOutput(n, 2) = c - 1
                arrOutput(n, 3) = Data(i, c)
                arrOutput(n, 4) = Evaluate("=LOOKUP(""" & Left$(Data(i, c), 1) & """,{""a"",1;""b"",2;""c"",3;""d"",4;""e"",5;""f"",0})")
                v = dic.Item(c - 1)
                arrOutput(n, 5) = v(0)
                arrOutput(n, 6) = v(1)
                arrOutput(n, 7) = Data(i, 32)
                arrOutput(n, 8) = Data(i, 33)
                arrOutput(n, 9) = Data(i, 34)
                arrOutput(n, 10) = Data(i, 35)
            Next
        Next
        
        On Error Resume Next
        Set ShtOutput = Worksheets("Output")
        If Err.Number <> 0 Then
            Set ShtOutput = Worksheets.Add
            ShtOutput.Name = "Output"
        End If
        Err.Clear: On Error GoTo 0
        
        With ShtOutput
            .Range("a1:j1") = [{"Nombre","Pregunta","Respuesta","Valor","Clasificacion","Tema","Puesto","Area","Antigüedad","Comentario"}]
            .Range("a2").Resize(n, 10).Value2 = arrOutput
        End With
        
    End Sub
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  3. #3
    Junior Member
    Join Date
    Jan 2014
    Posts
    6
    Rep Power
    0
    Wow! That was fast! I included the code in my Personal.xlsb sheet and run it on the file I sent to you. I stops at an error message that I uploaded in this message:"subscript out of range". I also included the debug screen.
    I was trying the understand the logic and it is still challenging for me to decipher some of the limits of the variables or arrays (i, c, n, etc.). I understand, for example, that in the line:"List = Worksheets("sheet2").Range("a7:g40").Value2 '<< adjust this range", as far as the data is in the exact same range as you saw in my file, it's ok. Right?
    Anyway, I'm most hopeful I will tackle this survey processing and if you would like to assist me a bit more I'd be most grateful.
    Attached Images Attached Images

  4. #4
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    Hi

    If you are running this code from the Personal.xlsb, try this version.

    Code:
    Option Explicit
    
    Sub kTest()
        
        Dim Data, i As Long, n As Long, c As Long, dic As Object
        Dim arrOutput(), List, v, ShtOutput As Worksheet
        
        Set dic = CreateObject("scripting.dictionary")
            dic.comparemode = 1
        
        Data = ActiveWorkbook.Worksheets("form responses").Range("a1").CurrentRegion.Resize(, 35).Value2
        List = ActiveWorkbook.Worksheets("sheet2").Range("a7:g40").Value2 '<< adjust this range
        
        For i = 1 To UBound(List, 1)
            dic.Item(List(i, 1)) = Array(List(i, 7), List(i, 2))
        Next
        
        ReDim arrOutput(1 To UBound(Data, 2) * 35, 1 To 10)
        
        For i = 2 To UBound(Data, 1)
            For c = 2 To UBound(Data, 2) - 4
                n = n + 1
                arrOutput(n, 1) = Data(i, 1)
                arrOutput(n, 2) = c - 1
                arrOutput(n, 3) = Data(i, c)
                arrOutput(n, 4) = Evaluate("=LOOKUP(""" & Left$(Data(i, c), 1) & """,{""a"",1;""b"",2;""c"",3;""d"",4;""e"",5;""f"",0})")
                v = dic.Item(c - 1)
                arrOutput(n, 5) = v(0)
                arrOutput(n, 6) = v(1)
                arrOutput(n, 7) = Data(i, 32)
                arrOutput(n, 8) = Data(i, 33)
                arrOutput(n, 9) = Data(i, 34)
                arrOutput(n, 10) = Data(i, 35)
            Next
        Next
        
        On Error Resume Next
        Set ShtOutput = ActiveWorkbook.Worksheets("Output")
        If Err.Number <> 0 Then
            Set ShtOutput = ActiveWorkbook.Worksheets.Add
            ShtOutput.Name = "Output"
        End If
        Err.Clear: On Error GoTo 0
        
        With ShtOutput
            .Range("a1:j1") = [{"Nombre","Pregunta","Respuesta","Valor","Clasificacion","Tema","Puesto","Area","Antigüedad","Comentario"}]
            .Range("a2").Resize(n, 10).Value2 = arrOutput
            .Range("a2").Resize(n, 10).WrapText = False
        End With
        
    End Sub
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  5. #5
    Junior Member
    Join Date
    Jan 2014
    Posts
    6
    Rep Power
    0
    Success! I attached the worksheet in case you find it useful for something else. Thank you so much!
    Attached Files Attached Files

  6. #6
    Junior Member
    Join Date
    Jan 2014
    Posts
    6
    Rep Power
    0
    Hi there! Despite my happiness in my previous mail, when I came to process the actual survey data (147 rows, 35 columns) I got a "subscript out of range" message that I couldn´t decipher.
    I managed to attach my spreadsheet and a screen capture of the debug page in vba.
    I would greatly appreciate your help to figure out what's going on.
    Best regards.
    Attached Images Attached Images
    Attached Files Attached Files

  7. #7
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    Hi

    Replace
    Code:
    ReDim arrOutput(1 To UBound(Data, 2) * 35, 1 To 10)
    with

    Code:
    ReDim arrOutput(1 To UBound(Data, 1) * 35, 1 To 10)
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  8. #8
    Junior Member
    Join Date
    Jan 2014
    Posts
    6
    Rep Power
    0
    Now it did the job! You just helped me be on track with my task. Deeply grateful!

  9. #9

    Survey

    Hey "Renczi" Your survey related discussion really very important. Actually If you need any useful data about the survey so you can communication with us.
    iReward Survey provides rewards at the end of the path, including offers for paid surveys, cash prizes, contests, cheap stuff, games, sweepstakes, and more. Complete the entire survey with valid answers to claim your rewards.

  10. #10
    Junior Member
    Join Date
    Jan 2014
    Posts
    6
    Rep Power
    0
    Quote Originally Posted by johnabrahaml View Post
    Hey "Renczi" Your survey related discussion really very important. Actually If you need any useful data about the survey so you can communication with us.
    Not sure if you need me to do something else.

Similar Threads

  1. RefersTo:=Range [transpose(..)]
    By PcMax in forum Excel Help
    Replies: 1
    Last Post: 02-06-2014, 04:41 AM
  2. Transpose A Column Of Data In To A Table
    By gunjan.nasit in forum Excel Help
    Replies: 4
    Last Post: 05-20-2013, 12:33 AM
  3. Unable to Get ElementID In VBA IE Automation
    By ashu1990 in forum Excel Help
    Replies: 9
    Last Post: 03-28-2013, 11:58 AM
  4. VBA IE Internet Explorer Automation Through ElementID
    By mrmmickle1 in forum Excel Help
    Replies: 3
    Last Post: 01-22-2013, 06:20 AM
  5. Transpose data into Rows
    By vikash200418 in forum Excel Help
    Replies: 2
    Last Post: 04-10-2012, 11:02 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •