I need to transform the Excel spreadsheet described below. What code would I use?

Posted on 2011-10-21
Last Modified: 2012-05-12
This question is a variation on a couple of similar questions I posted recently.
I have attached an Excel 2007 spreadsheet (Sample) that contains a small sample of a larger output file.
Another sheet is included with the expected output.

These data represent 4 subjects (Column A) who answered 7 questions. Questions 1,2, & 7 have 5 possible answers numbered  5,4,3,2,1 represented in columns B:K (Q 1-2), AB:AF (Q7) in Row 1. Questions 3 - 6 have 4 possible answers numbered 1 - 4 (Q3,4,5) and 4,3,2,1 (Q6) in columns L:AA in row 1. PLEASE NOTE: Questions 1 and 3 have text included in the answer in addition to the number in Row 1.

Each subject chose 1 of the 5 answers for Q 1-2, 7 and chose one of the 4 answers for Q 3-6.  The answer they chose is marked in that subject's row under the appropriate column with a 1. I need code that would transform each answer into the actual numerical choice shown in the same column in Row 1.
This number should be  displayed  in the appropriate Subject's Row under the column names for each question -Q1 – Q7 (See Output Sheet).  

Question by:PDSWSS
    LVL 24

    Accepted Solution

    Another variation on a theme. This will only work if the question codes are single-digit (e.g. 1-9) but it could be changed if this were not always the case:
    Sub x()
    Dim r As Range, n As Long, i, j As Long, c As Long, v
    v = Array(5, 5, 4, 4, 4, 4, 5)  'number of options for each question
    With Sheets("Sample")
        .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Copy Sheets("OutputExample").Range("A2")
        For n = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            Set r = .Cells(n, 2).Resize(, v(j))
            c = 1
            Do While Not IsEmpty(r(1))
                i = Application.Match(1, r, 0)
                c = c + 1
                If IsNumeric(i) Then
                    Sheets("OutputExample").Cells(Rows.Count, c).End(xlUp)(2) = Left(r(1).Offset(1 - n, i - 1), 1)
                    Sheets("OutputExample").Cells(Rows.Count, c).End(xlUp)(2) = 0
                End If
                Set r = r.Offset(, v(j))
                j = j + 1
            j = 0
        Next n
    End With
    With Sheets("OutputExample")
        With .Range("B2", .Range("B2").End(xlToRight)).Offset(-1)
            .Formula = "=""Q"" & column()-1"
            .Value = .Value
        End With
    End With
    End Sub

    Open in new window


    Author Comment

    Brilliant. You are a whiz. Saved me a lot of time. Thank you very, very much.

    The subject IDs did not appear in column A. But this is trivial. No need to spend any more time.

    Have a great weekend.  

    Author Closing Comment

    Brilliant answers and thanks again.


    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    How your wiki can always stay up-to-date

    Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
    - Increase transparency
    - Onboard new hires faster
    - Access from mobile/offline

    Suggested Solutions

    Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
    Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
    This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
    This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

    760 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    8 Experts available now in Live!

    Get 1:1 Help Now