Learn how to a build a cloud-first strategyRegister Now

x
Solved

# How would I make the transformations described in this question using code?

Posted on 2011-10-21
Medium Priority
196 Views
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 8 questions. Questions 1,2,3, 7, 8 have 5 possible answers numbered  0-4, represented in columns B:P ( Q 1-3) and Z:AI (Q 7,8) in Row 1. Questions 4,5,6 have 3 possible answers numbered 0-2 in columns R:Y in row 1. Each subject chose 1 of the 5 answers for Q 1-3, 7,8 and chose one of the 3 answers for Q 4-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 – Q8(See Output Sheet).

Thanks

EE3.4.xlsx
0
Question by:PDSWSS
• 8
• 7
• 2

LVL 24

Accepted Solution

StephenJR earned 1000 total points
ID: 37009216
I recognised this from your earlier question, and tweaked my answer to that, so now there is an array which stores the number of columns for each question:
``````Sub x()

Dim r As Range, n As Long, i As Long, j As Long, c As Long, v

v = Array(5, 5, 5, 3, 3, 3, 5, 5)

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) - 1
c = c + 1
Sheets("OutputExample").Cells(Rows.Count, c).End(xlUp)(2) = i
Set r = r.Offset(, v(j))
j = j + 1
Loop
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
``````
0

LVL 12

Assisted Solution

kgerb earned 1000 total points
ID: 37009271
This code will do what you want

Kyle
``````Sub SummarizeQuestions()
Dim QRows() As String, i As Long, j As Long
ReDim QRows(8)
QRows(1) = ("B:F")
QRows(2) = ("G:K")
QRows(3) = ("L:P")
QRows(4) = ("Q:S")
QRows(5) = ("T:V")
QRows(6) = ("W:Y")
QRows(8) = ("AE:AI")

For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To UBound(QRows)
With Sheets("OutputExample (2)").Cells(j, 1)
.Value = Cells(j, 1)
'Application.Intersect(Columns(QRows(i)), Rows(j)).Select
.Offset(, i) = WorksheetFunction.Match(1, Application.Intersect(Columns(QRows(i)), Rows(j)), 0) - 1
End With
Next i
Next j
End Sub
``````
Q-27409578-RevA.xlsm
0

Author Comment

ID: 37009303

You are good. One try worked perfectly.

Q. I have two more forms I need to transform. However, they have text in addition to a number in Row A in each column.
Would I need to delete the text for your code to work in these cases?

Q. Also would your code work in the case where  the  answers in Row A  went  in ascending and then descending order eg   12345543211234554321

Thanks
0

LVL 24

Expert Comment

ID: 37009317
1. If you mean instead of 1 the cells contain e.g. A1 then yes either your sheet or the code would have to be changed.

2. Not sure I follow, do you mean row 1, A is a column?
0

Author Comment

ID: 37009319
I sent the message above to StephenJR before I got  kgerb's solution.

Did not test kgerb's solution yet.
0

LVL 24

Expert Comment

ID: 37009327
Btw Kyle has also posted a solution so please acknowledge that.
0

LVL 24

Expert Comment

ID: 37009330
Cross-posted.
0

Author Comment

ID: 37009334
StephenJR

1. If you mean instead of 1 the cells contain e.g. A1 then yes either your sheet or the code would have to be changed.

More complex - eg  1. No increase,   2. feels talkative,  3. fairly tired,  4. very tired.  I would need code that would delete the text.
I will make a separate post.

2. Not sure I follow, do you mean row 1, A is a column?

My mistake  Row 1 not Row A. Sorry about that.

Q. CORRECTED - Also would your code work in the case where  the  answers in Row 1  went  in ascending and then descending order eg    123455432112344321
0

LVL 24

Expert Comment

ID: 37009344
All this could be catered for, I suggest you post an illustrative workbook and explain which bits might vary and how.
0

Author Comment

ID: 37009373
kgerb

Tried your code and got Runtime error '9'
Subscript out of range p

On Debug   Highlighted:        "With Sheets("OutputExample (2)").Cells(j, 1)"

Any ideas?
0

Author Comment

ID: 37009377
StephenJR

Thanks. Will post as a separate question and will wait to award points until I hear back from Kyle.
0

LVL 24

Expert Comment

ID: 37009395
Just a syntax error in Kyle's code, change to

With Sheets("OutputExample").Cells(j, 1)
0

LVL 12

Expert Comment

ID: 37009419
Stephenjr,
Thank you for correcting my code.  I created another sheet in my example workbook so I would not blow away the original values.  I forgot to change the code back.  Thanks again.

Kyle
0

Author Comment

ID: 37009422
That's very generous.  First time I have seen one expert solve a bug in another expert's code.

In this case, should I split the points?
0

LVL 24

Expert Comment

ID: 37009434
That's fine with me, thanks.
0

Author Closing Comment

ID: 37009457
Thanks for both of your solutions.
0

Author Comment

ID: 37009522
0

## Featured Post

Question has a verified solution.

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

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This article describes a serious pitfall that can happen when deleting shapes using VBA.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
###### Suggested Courses
Course of the Month20 days, 16 hours left to enroll