If desired, send your file to my address below along with this msg and
a clear explanation of what you want and before/after examples.


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Jcraig713" wrote in message
...
Hi. I need to reorder my data based on the code below. I currently have
source data of:

A B C D E F G
RoomPeriod Term CrsCode Section Course Tchr
Craig 1 HS1 HSS1 2 Algebra C5
Craig 2 HS1 HSS1 6 Algebra C5
Craig 3 HS1 HSS1 1 Algebra C5
Craig 4 HS1 HSS1 4 Algebra C5
Craig 5 HS1 HSS1 5 Algebra C5

I need the results to be this; teacher along the left and course and room
number in the cells:

Tchr P1 P2 P3 P4 P5 P6
Craig Alg C-5 Alg C-5 Alg C-5 Alg C-5 Alg C-5


Can you help amend my code below to do this. I am not sure how to make
the
course name and room number merge to one field in the grid from two cells:


Option Explicit
Dim wsSource As Worksheet
Dim wsTarget As Worksheet

Sub CreateGridRprt()
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 = 44 ' 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

End Sub


Thanks in advance for your help.