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

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)

<(E-Mail Removed)> wrote in message
news:54cbdfd1-8238-4b53-9b24-(E-Mail Removed)...
> 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
>

On 15 Feb, 12:36, "Bob Phillips" <bob....@somewhere.com> wrote:
> 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.godd...@gmail.com> wrote in message
>
> news:54cbdfd1-8238-4b53-9b24-(E-Mail Removed)...
>
> > 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

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

>karl.godd...@gmail.com wrote:
> > 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


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