Transpose Cell Contents

R

RB

I have data in this format about the subjects that students take

Student A Student B Student C Student D
Math Yes No Yes No
Science No No Yes Yes
Arts Yes Yes No No
English Literature No Yes Yes Yes

I want the data to be represented in this fashion:

Student A Math
Arts
Student B Arts
English Literature
.........

Any suggestions on this?

Thanks!
 
R

Ron Rosenfeld

I have data in this format about the subjects that students take

Student A Student B Student C Student D
Math Yes No Yes No
Science No No Yes Yes
Arts Yes Yes No No
English Literature No Yes Yes Yes

I want the data to be represented in this fashion:

Student A Math
Arts
Student B Arts
English Literature
........

Any suggestions on this?

Thanks!

Easily done with a VBA Macro.
Assuming your data starts in A1, the following will put the results into a table starting at A15. Obviously, you may want to move it and how to do it should be obvious from the macro.
You also may want to change the method of selecting the data to be processed.
If you are not familiar with VBA Macros, I would start by reading the HELP information.

To enter this Macro (Sub), <alt-F11> opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8> opens the macro dialog box. Select the macro by name, and <RUN>.

===========================================
Option Explicit
Sub CoursesByStudent()
Dim aStudents() As String
Dim aCourses() As String
Dim R As Range, C As Range
Dim I As Long, J As Long, K As Long
Dim vSrc As Variant 'Source Data
Dim vRes() As Variant 'Results Array
Dim rRes As Range
Dim bNamed As Boolean

Set R = Range("a1").CurrentRegion
vSrc = R

'Results Range
' Could be on a different worksheet,
' or even replace the original data

Set rRes = Range("a15")


'Students
ReDim aStudents(1 To UBound(vSrc, 2) - 1)
For I = 2 To UBound(vSrc, 2)
aStudents(I - 1) = vSrc(1, I)
Next I

'Courses
ReDim aCourses(1 To UBound(vSrc, 1) - 1)
For I = 2 To UBound(vSrc, 1)
aCourses(I - 1) = vSrc(I, 1)
Next I

'Set up Results array
'Results:
' Num of columns = 2
' Num of rows = Num of Yes's
K = 0
ReDim vRes(1 To WorksheetFunction.CountIf(R, "Yes"), 1 To 2)
For I = 1 To UBound(aStudents)
bNamed = False
For J = 1 To UBound(aCourses)
If vSrc(J + 1, I + 1) = "Yes" Then
K = K + 1
vRes(K, 1) = IIf(bNamed, "", aStudents(I))
bNamed = True
vRes(K, 2) = aCourses(J)
End If
Next J
Next I

Application.ScreenUpdating = False
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1), columnsize:=UBound(vRes, 2))
rRes = vRes
Application.ScreenUpdating = True

End Sub
====================================================
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top