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
17
Medium Priority
?
196 Views
Last Modified: 2012-08-13
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
Comment
Question by:PDSWSS
  • 8
  • 7
  • 2
17 Comments
 
LVL 24

Accepted Solution

by:
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

Open in new window

0
 
LVL 12

Assisted Solution

by:kgerb
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(7) = ("Z:AD")
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

Open in new window

Q-27409578-RevA.xlsm
0
 

Author Comment

by:PDSWSS
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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 24

Expert Comment

by:StephenJR
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

by:PDSWSS
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

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

Expert Comment

by:StephenJR
ID: 37009330
Cross-posted.
0
 

Author Comment

by:PDSWSS
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

by:StephenJR
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

by:PDSWSS
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

by:PDSWSS
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

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

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

Expert Comment

by:kgerb
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

by:PDSWSS
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

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

Author Closing Comment

by:PDSWSS
ID: 37009457
Thanks for both of your solutions.
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

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.

810 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