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

Posted on 2011-10-21
Medium Priority
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
  • 2
LVL 24

Accepted Solution

StephenJR earned 2000 total points
ID: 37009565
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

ID: 37009669
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

ID: 37009672
Brilliant answers and thanks again.


Featured Post

Prep for the ITIL® Foundation Certification Exam

December’s Course of the Month is now available! Enroll to learn ITIL® Foundation best practices for delivering IT services effectively and efficiently.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

850 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