View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Ron Rosenfeld[_2_] Ron Rosenfeld[_2_] is offline
external usenet poster
 
Posts: 1,045
Default Transpose Cell Contents

On Wed, 9 Apr 2014 14:36:24 -0700 (PDT), RB wrote:

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
================================================== ==