Hello. I have source data numbering about 2500 records as shown below:

A B C D E F G
Rm Period Term crscode sec course teacher
A1 2 HS1 HSPE110 1 Health Koenings
A1 3 HS1 HSPE110 2 Health Koenings
A1 4 HS1 HSPE110 3 Health Koenings
A1 6 HS1 HSPE110 4 Health Koenings
A1 7 HS1 HSPE110 5 Health Koenings
A2 2 HS1 HSSP181 1 Geography Moriconi
A2 3 HS1 HSSP220 1 English10 S1 Moriconi
A2 7 HS1 HSSP380 1 History S1 Moriconi
A3 2 HS1 HSCT100 2 Business Morton
A3 5 HS1 HSCT100 4 Business Morton
A3 6 HS1 HSCT210 1 Busin Mgmt Morton
A3 7 HS1 HSCT100 5 Business Morton

I need to re-order the data so the data shows like the following; one room
to many classes in periods on one record line:

Room P1 P2 P3 P4 P5 P6 P7
P8
A1 Health Health Health Health Health
A2 Geog Engl10 Hist
A3 Busin Busin BusMgt Busin

Any help would be greatly appreciated.

Try this code. Change source and dest sheet names as required.


Sub SortByRooms()
Set SourceSht = Sheets("Sheet1")
Set DestSht = Sheets("Sheet2")


With DestSht
.Range("A1") = "Room"
For Period = 1 To 8
.Cells(1, Period + 1) = "P" & Period
Next Period
End With

NewRow = 2
RowCount = 2

With SourceSht
Do While .Range("A" & RowCount) < ""
Room = .Range("A" & RowCount)
Period = .Range("B" & RowCount)
Course = .Range("F" & RowCount)

With DestSht
'check if room already exists
Set c = .Columns("A").Find(what:=Room, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Range("A" & NewRow) = Room
.Cells(NewRow, Period + 1) = Course
NewRow = NewRow + 1
Else
'check if room already assigned
If .Cells(c.Row, Period + 1) < "" Then
MsgBox ("All ready in use Room : " & Room & " , Period: " &
Period)
Else
.Cells(c.Row, Period + 1) = Course
End If

End If

End With
RowCount = RowCount + 1
Loop
End With

End Sub


"Jcraig713" wrote:

Hello. I have source data numbering about 2500 records as shown below:

A B C D E F G
Rm Period Term crscode sec course teacher
A1 2 HS1 HSPE110 1 Health Koenings
A1 3 HS1 HSPE110 2 Health Koenings
A1 4 HS1 HSPE110 3 Health Koenings
A1 6 HS1 HSPE110 4 Health Koenings
A1 7 HS1 HSPE110 5 Health Koenings
A2 2 HS1 HSSP181 1 Geography Moriconi
A2 3 HS1 HSSP220 1 English10 S1 Moriconi
A2 7 HS1 HSSP380 1 History S1 Moriconi
A3 2 HS1 HSCT100 2 Business Morton
A3 5 HS1 HSCT100 4 Business Morton
A3 6 HS1 HSCT210 1 Busin Mgmt Morton
A3 7 HS1 HSCT100 5 Business Morton

I need to re-order the data so the data shows like the following; one room
to many classes in periods on one record line:

Room P1 P2 P3 P4 P5 P6 P7
P8
A1 Health Health Health Health Health
A2 Geog Engl10 Hist
A3 Busin Busin BusMgt Busin

Any help would be greatly appreciated.

nice and simple this one :)

Option Explicit
Dim wsSource As Worksheet
Dim wsTarget As Worksheet

Sub Tabulate()

Dim cell As Range
Dim rm As String
Dim period As Long
Dim course As String
Dim rw As Long

Set wsSource = ActiveSheet
Set wsTarget = Worksheets.Add()

Set cell = wsSource.Range("A2")

Do Until cell.Value = ""
rm = cell.Value
period = cell.Offset(, 1).Value
course = cell.Offset(, 5).Value

rw = checkrow(rm)
wsTarget.Cells(rw, period + 1) = course

Set cell = cell.Offset(1)
Loop
End Sub
Function checkrow(rm As String)
On Error Resume Next
checkrow = WorksheetFunction.Match(rm, wsTarget.Range("A1:A1000"),
False)
If checkrow = 0 Then
checkrow = wsTarget.Range("A65000").End(xlUp).Row + 1
wsTarget.Range("A65000").End(xlUp).Offset(1) = rm
End If
End Function


mail me direct and I'll send the workbook

"Jcraig713" wrote in message
...
Hello. I have source data numbering about 2500 records as shown below:

A B C D E F G
Rm Period Term crscode sec course teacher
A1 2 HS1 HSPE110 1 Health Koenings
A1 3 HS1 HSPE110 2 Health Koenings
A1 4 HS1 HSPE110 3 Health Koenings
A1 6 HS1 HSPE110 4 Health Koenings
A1 7 HS1 HSPE110 5 Health Koenings
A2 2 HS1 HSSP181 1 Geography Moriconi
A2 3 HS1 HSSP220 1 English10 S1 Moriconi
A2 7 HS1 HSSP380 1 History S1 Moriconi
A3 2 HS1 HSCT100 2 Business Morton
A3 5 HS1 HSCT100 4 Business Morton
A3 6 HS1 HSCT210 1 Busin Mgmt Morton
A3 7 HS1 HSCT100 5 Business Morton

I need to re-order the data so the data shows like the following; one room
to many classes in periods on one record line:

Room P1 P2 P3 P4 P5 P6 P7
P8
A1 Health Health Health Health Health
A2 Geog Engl10
Hist
A3 Busin Busin BusMgt Busin

Any help would be greatly appreciated.

Patrick, thanks! Do you think we could take this a step further? You
indicated to mail you direct but I do not know how to see your email address?
So I thought I would respond here.

I would like to have period 1, 2, 3 etc. along the top for column headers.

Also, in some instances, there are two classes scheduled for the same
period. In some cases this is ok (more than one class is offered at a time
in a room) and in other instances, it should not be occurring.

In the cells where the course name is listed by period to the right of the
room number, can those instances of multiplecourses all be listed in the
same cell perhaps seperated by commas or other method, then highlighted in
red to stand out?

Then, in those cells that are null or blank, can those blank cells be filled
with gray highlight to stand out visually as an open room to schedule classes
in? My intention is to see what course is scehduled where, which courses my
be duplicated in a period, and open spots I have to move the class to.

I cannot tell you how much this is helping me. Days of work of cross
referencing reports is replaced. I just hope we can take this a step
further. Thanks.


"Patrick Molloy" wrote:

nice and simple this one :)

Option Explicit
Dim wsSource As Worksheet
Dim wsTarget As Worksheet

Sub Tabulate()

Dim cell As Range
Dim rm As String
Dim period As Long
Dim course As String
Dim rw As Long

Set wsSource = ActiveSheet
Set wsTarget = Worksheets.Add()

Set cell = wsSource.Range("A2")

Do Until cell.Value = ""
rm = cell.Value
period = cell.Offset(, 1).Value
course = cell.Offset(, 5).Value

rw = checkrow(rm)
wsTarget.Cells(rw, period + 1) = course

Set cell = cell.Offset(1)
Loop
End Sub
Function checkrow(rm As String)
On Error Resume Next
checkrow = WorksheetFunction.Match(rm, wsTarget.Range("A1:A1000"),
False)
If checkrow = 0 Then
checkrow = wsTarget.Range("A65000").End(xlUp).Row + 1
wsTarget.Range("A65000").End(xlUp).Offset(1) = rm
End If
End Function


mail me direct and I'll send the workbook

"Jcraig713" wrote in message
...
Hello. I have source data numbering about 2500 records as shown below:

A B C D E F G
Rm Period Term crscode sec course teacher
A1 2 HS1 HSPE110 1 Health Koenings
A1 3 HS1 HSPE110 2 Health Koenings
A1 4 HS1 HSPE110 3 Health Koenings
A1 6 HS1 HSPE110 4 Health Koenings
A1 7 HS1 HSPE110 5 Health Koenings
A2 2 HS1 HSSP181 1 Geography Moriconi
A2 3 HS1 HSSP220 1 English10 S1 Moriconi
A2 7 HS1 HSSP380 1 History S1 Moriconi
A3 2 HS1 HSCT100 2 Business Morton
A3 5 HS1 HSCT100 4 Business Morton
A3 6 HS1 HSCT210 1 Busin Mgmt Morton
A3 7 HS1 HSCT100 5 Business Morton

I need to re-order the data so the data shows like the following; one room
to many classes in periods on one record line:

Room P1 P2 P3 P4 P5 P6 P7
P8
A1 Health Health Health Health Health
A2 Geog Engl10
Hist
A3 Busin Busin BusMgt Busin

Any help would be greatly appreciated.

This is almost same as Joel's code, but try this.
First, select your data sheet and run the macro below

Sub talbleset()
Dim srcsh As Worksheet, dstsh As Worksheet
Dim pcell As Range, tcell As Range
Dim pmax As Long, i As Long

Set srcsh = ActiveSheet
pmax = Application.max(Columns("B"))
Set dstsh = Worksheets.Add(after:=srcsh)

Range("A1") = srcsh.Range("A1")
For i = 1 To pmax
Cells(1, i + 1) = "P" & i
Next

srcsh.Activate
Set pcell = Range("A2")
Do While (pcell < "")
Set tcell = dstsh.Columns("A") _
.Find(pcell.Value, LookIn:=xlValues, lookat:=xlWhole)
If tcell Is Nothing Then
Set tcell = dstsh.Cells(Cells.Rows.Count, "A") _
.End(xlUp).Cells(2, 1)
tcell = pcell
tcell.Cells(1, pcell.Cells(1, "B") + 1) = _
pcell.Cells(1, "F")
Else
If tcell.Cells(1, pcell.Cells(1, "B") + 1) < "" Then
tcell.Cells(1, pcell.Cells(1, "B") + 1) = _
tcell.Cells(1, pcell.Cells(1, "B") + 1) & _
", " & Chr(10) & pcell.Cells(1, "F")
tcell.Cells(1, pcell.Cells(1, "B") + 1). _
Interior.ColorIndex = 6 ' paint yellow
Else
tcell.Cells(1, pcell.Cells(1, "B") + 1) = _
pcell.Cells(1, "F")
End If
End If
Set pcell = pcell(2, "A")
Loop
'paint blank cell with gray color
dstsh.Cells.SpecialCells(xlCellTypeBlanks).Interio r.ColorIndex = 15
'just for adjusting column width
For i = 1 To pmax + 1
If Application.CountA(dstsh.Columns(i)) < 1 Then
dstsh.Columns(i).ColumnWidth = 20
dstsh.Columns(i).AutoFit
dstsh.Columns(i).ColumnWidth = dstsh.Columns(i).ColumnWidth + 1
End If
Next
'just for adjusting row's height
For Each pcell In dstsh.Range("A1").CurrentRegion
pcell.EntireRow.AutoFit
Next

dstsh.Activate

End Sub


Keiji

Jcraig713 wrote:
Patrick, thanks! Do you think we could take this a step further? You
indicated to mail you direct but I do not know how to see your email address?
So I thought I would respond here.

I would like to have period 1, 2, 3 etc. along the top for column headers.

Also, in some instances, there are two classes scheduled for the same
period. In some cases this is ok (more than one class is offered at a time
in a room) and in other instances, it should not be occurring.

In the cells where the course name is listed by period to the right of the
room number, can those instances of multiplecourses all be listed in the
same cell perhaps seperated by commas or other method, then highlighted in
red to stand out?

Then, in those cells that are null or blank, can those blank cells be filled
with gray highlight to stand out visually as an open room to schedule classes
in? My intention is to see what course is scehduled where, which courses my
be duplicated in a period, and open spots I have to move the class to.

I cannot tell you how much this is helping me. Days of work of cross
referencing reports is replaced. I just hope we can take this a step
further. Thanks.


"Patrick Molloy" wrote:

nice and simple this one :)

Option Explicit
Dim wsSource As Worksheet
Dim wsTarget As Worksheet

Sub Tabulate()

Dim cell As Range
Dim rm As String
Dim period As Long
Dim course As String
Dim rw As Long

Set wsSource = ActiveSheet
Set wsTarget = Worksheets.Add()

Set cell = wsSource.Range("A2")

Do Until cell.Value = ""
rm = cell.Value
period = cell.Offset(, 1).Value
course = cell.Offset(, 5).Value

rw = checkrow(rm)
wsTarget.Cells(rw, period + 1) = course

Set cell = cell.Offset(1)
Loop
End Sub
Function checkrow(rm As String)
On Error Resume Next
checkrow = WorksheetFunction.Match(rm, wsTarget.Range("A1:A1000"),
False)
If checkrow = 0 Then
checkrow = wsTarget.Range("A65000").End(xlUp).Row + 1
wsTarget.Range("A65000").End(xlUp).Offset(1) = rm
End If
End Function


mail me direct and I'll send the workbook

"Jcraig713" wrote in message
...
Hello. I have source data numbering about 2500 records as shown below:

A B C D E F G
Rm Period Term crscode sec course teacher
A1 2 HS1 HSPE110 1 Health Koenings
A1 3 HS1 HSPE110 2 Health Koenings
A1 4 HS1 HSPE110 3 Health Koenings
A1 6 HS1 HSPE110 4 Health Koenings
A1 7 HS1 HSPE110 5 Health Koenings
A2 2 HS1 HSSP181 1 Geography Moriconi
A2 3 HS1 HSSP220 1 English10 S1 Moriconi
A2 7 HS1 HSSP380 1 History S1 Moriconi
A3 2 HS1 HSCT100 2 Business Morton
A3 5 HS1 HSCT100 4 Business Morton
A3 6 HS1 HSCT210 1 Busin Mgmt Morton
A3 7 HS1 HSCT100 5 Business Morton

I need to re-order the data so the data shows like the following; one room
to many classes in periods on one record line:

Room P1 P2 P3 P4 P5 P6 P7
P8
A1 Health Health Health Health Health
A2 Geog Engl10
Hist
A3 Busin Busin BusMgt Busin

Any help would be greatly appreciated.