Arranging Excel Data For Survey Analysis

[Ninsuke]

Hey all,

I am currently a student who is partaking in compiling my survey results.

I want to pair the variables up in a row so that i am able to see a person's data more properly as shown by the table below. Ideally this is what i want to achieve.

Question 1	Question 2	Question 3
Age	Gender	Occupation
51-60	Male	Businessmen
21-30	Female	Worker
31-40	Male	Housewife
21-30	Male	Worker
15-20	Male	Student
41-50	Female	Professional
21-30	Female	Professional

<colgroup><col><col><col></colgroup><tbody>
</tbody>

However, the arrangement of my current data is not what i want as the results of each person is displayed (as attached) individually and i can't compare them.

https://www.dropbox.com/s/cmwv7a7qlvnwg6w/SMARTSURVEY.xlsx

I am expecting at least 200 more respondents and i need a way to automatically arrange the data like the above table.

Any help would be greatly appreciated.

Regards
Derek

 

[ParamRay]

Derek,

Please try the following code. (You don't need to have the survey workbook already open to run the macro.)

Firstly, you'll need to change the variables Directory and Filename appropriately in order for the macro to locate your survey workbook.

Also, I am assuming that your raw data is in the worksheet "Sheet1". If this is not the case, you'll also need to modify the RawData variable beforehand.

Sub CreateDataList()

    Dim Directory As String
    Dim Filename As String
    Dim Path As String
    Dim RawData As Worksheet
    Dim SurveyData As Workbook
    Dim Count As Long
    Dim Cell As Range
    
    Directory = "C:\Users\jsmith\Desktop" 'set location of survey workbook
    Filename = "SMARTSURVEY.xlsx"   'set filename of survey workbook
    
    Path = Directory & Application.PathSeparator & Filename
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    'Close survey workbook if already open
    On Error Resume Next
    Workbooks(Filename).Close SaveChanges:=False
    On Error GoTo 0
    
    'Exit if survey wookbook not found
    If Dir(Path) = vbNullString Then
        MsgBox Prompt:="File does not exist:" & vbCrLf & Path, Buttons:=vbCritical, Title:="Error"
        Exit Sub
    End If
    
    Set RawData = Workbooks.Open(Filename:=Path).Worksheets("Sheet1")   'set sheet containing raw data
    Set SurveyData = Workbooks.Add
    
    With SurveyData.Worksheets(1)
    
        .Range("A1").Value = "Survey"
        .Range("B1").Value = "Age"
        .Range("C1").Value = "Gender"
        .Range("D1").Value = "Occupation"
    
        Count = 1
        For Each Cell In Intersect(RawData.UsedRange, RawData.Range("A:A"))
            If Cell.Value = "* denotes required field." Then
                Count = Count + 1
                .Cells(Count, 1).Value = Count - 1
                .Cells(Count, 2).Value = Trim(Cell.Offset(6, 1).Value)
                .Cells(Count, 3).Value = Trim(Cell.Offset(2, 1).Value)
                .Cells(Count, 4).Value = Trim(Cell.Offset(4, 1).Value)
            End If
        Next Cell
    
    End With
    
    Workbooks(Filename).Close SaveChanges:=False
    
    With SurveyData
        .SaveAs Filename:=Directory & Application.PathSeparator & "Survey Data.xlsx", FileFormat:=xlOpenXMLWorkbook
        .Close
    End With
    
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    MsgBox Prompt:="File created:" & vbCrLf & Directory & Application.PathSeparator _
        & "Survey Data.xlsx", Buttons:=vbInformation, Title:="Success"

End Sub

Cheers,
Greg

 

[Ninsuke]

Derek,

Please try the following code. (You don't need to have the survey workbook already open to run the macro.)

Firstly, you'll need to change the variables Directory and Filename appropriately in order for the macro to locate your survey workbook.

Also, I am assuming that your raw data is in the worksheet "Sheet1". If this is not the case, you'll also need to modify the RawData variable beforehand.

Sub CreateDataList()

    Dim Directory As String
    Dim Filename As String
    Dim Path As String
    Dim RawData As Worksheet
    Dim SurveyData As Workbook
    Dim Count As Long
    Dim Cell As Range
    
    Directory = "C:\Users\jsmith\Desktop" 'set location of survey workbook
    Filename = "SMARTSURVEY.xlsx"   'set filename of survey workbook
    
    Path = Directory & Application.PathSeparator & Filename
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    'Close survey workbook if already open
    On Error Resume Next
    Workbooks(Filename).Close SaveChanges:=False
    On Error GoTo 0
    
    'Exit if survey wookbook not found
    If Dir(Path) = vbNullString Then
        MsgBox Prompt:="File does not exist:" & vbCrLf & Path, Buttons:=vbCritical, Title:="Error"
        Exit Sub
    End If
    
    Set RawData = Workbooks.Open(Filename:=Path).Worksheets("Sheet1")   'set sheet containing raw data
    Set SurveyData = Workbooks.Add
    
    With SurveyData.Worksheets(1)
    
        .Range("A1").Value = "Survey"
        .Range("B1").Value = "Age"
        .Range("C1").Value = "Gender"
        .Range("D1").Value = "Occupation"
    
        Count = 1
        For Each Cell In Intersect(RawData.UsedRange, RawData.Range("A:A"))
            If Cell.Value = "* denotes required field." Then
                Count = Count + 1
                .Cells(Count, 1).Value = Count - 1
                .Cells(Count, 2).Value = Trim(Cell.Offset(6, 1).Value)
                .Cells(Count, 3).Value = Trim(Cell.Offset(2, 1).Value)
                .Cells(Count, 4).Value = Trim(Cell.Offset(4, 1).Value)
            End If
        Next Cell
    
    End With
    
    Workbooks(Filename).Close SaveChanges:=False
    
    With SurveyData
        .SaveAs Filename:=Directory & Application.PathSeparator & "Survey Data.xlsx", FileFormat:=xlOpenXMLWorkbook
        .Close
    End With
    
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    MsgBox Prompt:="File created:" & vbCrLf & Directory & Application.PathSeparator _
        & "Survey Data.xlsx", Buttons:=vbInformation, Title:="Success"

End Sub

Cheers,
Greg

Hi Mr Greg,

Thank you for your wisdom, I am exceptionally new to this code thing in EXCEL and i fear i have made some mistakes.

I went to google up how to input the code and managed to somehow copy and paste it into a VBA Module and run it.

However, upon running up the code the whole excel crashed and nothing turns up as shown by the link below:

https://www.dropbox.com/s/d47p5roix58dix7/Image1.jpg

If you don't mind can you explain to me how to get this done?

Regards
Derek

 

[ParamRay]

You were right to place the code into a standard code module in order to run it.

Before running the macro, change the following lines to match where your survey file:

Directory = "C:\Users\jsmith\Desktop"
Filename = "SMARTSURVEY.xlsx"

When you run the macro, it will display a dialog box telling you what it has done...