Columns to rows

[karl.goddard]

Hi

I have a tricky problem with a Worksheet just handed to me

at the moment the sheet is laid out like this

1 2 3
John Smith History
John Smith English
John Smith Science

and so on...

There are eleven rows per student

What I want is the layout to be like

1 2 3 4 5
John Smith History English Science

If there was only a few records I'd do a Transpose but there are
several hundred students in the sheet

Any help would be most welcome

Thanks
Karl

 

[Bob Phillips]

Public Sub ProcessData()
Dim i As Long
Dim iLastRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value And _
.Cells(i, "B").Value = .Cells(i - 1, "B").Value Then

.Cells(i, "C").Resize(, 100).Copy .Cells(i - 1, "D")
.Rows(i).Delete
End If

Next i

End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[karl.goddard]

Public Sub ProcessData()
Dim i As Long
Dim iLastRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value And _
.Cells(i, "B").Value = .Cells(i - 1, "B").Value Then

.Cells(i, "C").Resize(, 100).Copy .Cells(i - 1, "D")
.Rows(i).Delete
End If

Next i

End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

Hey Bob thanks for the reply...

Lost my broadband connection this afternoon so apologies for not
thanking you sooner!

While my inet connection was down me and a pal came up with this code
that works

Sub ReArrange()
Dim r1 As Integer
Dim r2 As Integer
Dim c2 As Integer
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim strFirst As String
Dim strSecond As String

Set sh1 = ActiveSheet
Set sh2 = Sheets(2)
r1 = 1
Do Until sh1.Cells(r1, 1) = ""
If strFirst = Trim$(sh1.Cells(r1, 1)) And strSecond = Trim$
(sh1.Cells(r1, 2)) Then

Else
r2 = r2 + 1
strFirst = Trim$(sh1.Cells(r1, 1))
strSecond = Trim$(sh1.Cells(r1, 2))
sh2.Cells(r2, 1) = strFirst
sh2.Cells(r2, 2) = strSecond
c2 = 2
End If
c2 = c2 + 1
sh2.Cells(r2, c2) = sh1.Cells(r1, 3)
sh2.Cells(1, c2) = "Subject" & c2 - 2
r1 = r1 + 1
Loop

End Sub

Even though it's a soloution I don't know if it's a good solution.
What do you think?

Thanks again for your code
Karl

 

[Tom]

Assuming I understood your needs correctly, this transposing thing
seems good enough for at least trying to use pivot tables with its
internal transposition mech. If you have a table:
name second name subject
John Smith AAA
John Smith BBB
John Smith CCC
Alice Wanderland AAA
Alice Wanderland BBB
Alice Wanderland CCC
Alice Wanderland DDD
then creating pivot tab row lables (name, sec name) and col lable
(subject) results in:

subject
name second name AAA BBB CCC DDD
Alice Wanderland
John Smith

And if you want subjects repeated in each row, then add a column
"subject2" with copied subjects names (clone "subject" col with
different heading name) to pivot tab source data, use this "subject2"
col as PT value field, use count aggregating function, and then use WS
formula IF(value field=1;column heading;""). This way you will get
below your pivot tab:

Alice Wanderland AAA BBB CCC DDD
John Smith AAA BBB CCC

Not sure if it is what you exaclly needed but pivots are at least
worth giving a try especially when trasposing

Tom