I have info in a spreadsheet that outlines the hours per week that a person
spends on a particular job. eg.


NAME JOB 18/6/07 25/6/07 2/7/07
Joe Bloggs ROAD 40 40 40
Charlie Brown ROAD 20 20 0
Susie Q ROAD 0 0 40
Charlie Brown BRIDGE 20 20 40
Susie Q BRIDGE 40 40 0

I would like to view this info in a different way but am not sure how to go
about it. I would like a list of names, each name appearing once and under
the date heading would appear the job that they worked on. Therefore the info
above would look like this:

NAME 18/6/07 25/6/07 2/7/07
Joe Bloggs ROAD ROAD ROAD
Charlie Brown ROAD, BRIDGE ROAD, BRIDGE BRIDGE
Susie Q BRIDGE BRIDGE ROAD

I don't want to use another sheet with formulas as it would be really heavy.
I thought running a macro would work but don't know how to do it.

Any help would be appreciated.

Ellen

Try the following code: test it with a copy of your workbook first, just in
case. The code goes into a regular module: press [Alt]+[F11] to open the VB
Editor then choose Insert | Module from its menu. Copy and paste this code
into it. Edit the definitions for the Const values I've provided to tailor
it to your actual workbook. As currently written, other than the worksheet
names involved, it is set up to work with data laid out as you've shown it
he names in column A starting at row 2, header row in row 1, dates
starting in column C, JOBS named in B. Any of that can be changed, just
one "MUST" that really needs to be followed: the dates must start in a column
to the right of the Names and JOB columns. I've actually tested this here
and it appears to do what you've requested.

Sub BuildByJobsSheet()
'assumptions:
' names are in column A
' Jobs are in column B
' hours worked on a job begin in column C
' dates begin in C1 and go across sheet unbroken
' dates MUST begin AFTER names & jobs
'change these Const values to match sheet names
'that are actually in your workbook

'name of sheet with list to work from
Const srcSheetName = "ByHours"
'name for new arrangement sheet
'sheet does not have to exist
'if it doesn't, it will be created
Const destSheetName = "ByJobs"
'change these to allow for different source sheet
'layouts.
Const nameColumn = "A"
Const jobColumn = "B"
Const firstDateColumn = "C"
' row with dates in it
Const dateRow = 1
' row with first name in it
' MUST be greater than 1
Const firstNameRow = 2

Dim srcSheet As Worksheet
Dim srcRange As Range
Dim srcLastRow As Long
Dim srcLastCol As Long
Dim srcBase As Range

Dim destSheet As Worksheet
Dim destRange As Range
Dim destBase As Range
Dim destLastRow As Long

Dim maxRows As Long
Dim tmpAddress As String
Dim anyCell As Object
Dim ListOfNames() As String
Dim NamesLoop As Long ' loop counter
Dim dateStartOffset As Long
Dim cOffset As Long ' loop counter for date columns
Dim rOffset As Long ' loop counter for names
Dim nameMatchFoundFlag As Boolean

'get proper value for last possible row# on sheet
If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 version of Excel
maxRows = Rows.Count
Else
'in Excel 2007 (or later)
maxRows = Rows.CountLarge
End If

Set srcSheet = Worksheets(srcSheetName)
tmpAddress = Range(nameColumn & firstNameRow).Offset(-1, 0).Address
Set srcBase = srcSheet.Range(tmpAddress)
'test if destination sheet exists
On Error Resume Next
Set destSheet = Worksheets(destSheetName)
If Err < 0 Then
'sheet doesn't exist
'create it
Err.Clear
On Error GoTo 0
srcSheet.Copy after:=Sheets(srcSheet.Name)
ActiveSheet.Name = "ByJob"
Set destSheet = ActiveSheet
End If
On Error GoTo 0
'prepare to rebuild new sheet
destSheet.Cells.Clear

tmpAddress = "A" & dateRow & ":" & _
srcSheet.Range("A" & dateRow).End(xlToRight).Address
Set srcRange = srcSheet.Range(tmpAddress)
srcLastCol = srcRange.Columns.Count
If srcLastCol < 3 Then
'nothing to do, no dates on source sheet!
Set srcRange = Nothing
Set srcSheet = Nothing
Exit Sub
End If
Application.ScreenUpdating = False
Set destRange = destSheet.Range(tmpAddress)
destRange.Value = srcRange.Value
destLastRow = 1
tmpAddress = Range(nameColumn & firstNameRow).Offset(-1, 0).Address
Set destBase = destSheet.Range(tmpAddress)
'get unique names from source sheet, column A
'and place into dynamic array ListOfNames()
'initialize and seed the array
ReDim ListOfNames(1 To 1)
ListOfNames(1) = srcSheet.Range(nameColumn & firstNameRow).Value

'assume continuous list of names
srcLastRow = srcSheet.Range(nameColumn & _
maxRows).End(xlUp).Row
'another test for anything to do
If srcLastRow < firstNameRow Then
'nothing to do, no names on source sheet!
Set srcRange = Nothing
Set srcSheet = Nothing
Application.ScreenUpdating = True
Exit Sub
End If

'pick up names and place one copy of
'each unique name into array ListOfNames()
Set srcRange = srcSheet.Range(nameColumn & firstNameRow & ":" _
& nameColumn & srcLastRow)
For Each anyCell In srcRange
nameMatchFoundFlag = False
For NamesLoop = LBound(ListOfNames) To _
UBound(ListOfNames)
If UCase(Trim(anyCell.Value)) = _
UCase(Trim(ListOfNames(NamesLoop))) Then
nameMatchFoundFlag = True
Exit For
End If
Next
If Not (nameMatchFoundFlag) Then
'new name, add to list
'if the cell is not empty
If Not IsEmpty(anyCell) Then
ReDim Preserve ListOfNames(1 To _
UBound(ListOfNames) + 1)
ListOfNames(UBound(ListOfNames)) = anyCell.Value
End If ' empty cell test
End If ' new name test
Next
'firstDateColumn
dateStartOffset = _
Range(firstDateColumn & 1).Column - srcBase.Column
'
'The real work begins
'for each name in ListOfNames()
'find name on source sheet, and for each
'date column, find out if they worked on a job
'and if they did, build up string JobsWorked
'to be placed on the destination sheet in proper column
'
For NamesLoop = LBound(ListOfNames) To UBound(ListOfNames)
destBase.Offset(NamesLoop, 0) = ListOfNames(NamesLoop)
For rOffset = 1 To srcLastRow - 1
For cOffset = dateStartOffset To srcLastCol - 1
'test if names match
If UCase(Trim(srcBase.Offset(rOffset, 0))) = _
UCase(Trim(ListOfNames(NamesLoop))) Then
'test if hours 0
If srcBase.Offset(rOffset, cOffset) 0 Then
destBase.Offset(NamesLoop, cOffset) = _
destBase.Offset(NamesLoop, cOffset) & " " & _
srcBase.Offset(rOffset, 1).Value
End If 'hours worked test
End If ' name match test
Next ' cOffset loop end
Next ' rOffset loop end
Next ' NamesLoop loop end
'get rid of JOBS column in new sheet
destSheet.Range(jobColumn & 1).EntireColumn.Delete
'release resources
Set srcRange = Nothing
Set srcBase = Nothing
Set srcSheet = Nothing
Set destBase = Nothing
Set destRange = Nothing
Set destSheet = Nothing
Application.ScreenUpdating = True
End Sub


"ellebelle" wrote:

I have info in a spreadsheet that outlines the hours per week that a person
spends on a particular job. eg.


NAME JOB 18/6/07 25/6/07 2/7/07
Joe Bloggs ROAD 40 40 40
Charlie Brown ROAD 20 20 0
Susie Q ROAD 0 0 40
Charlie Brown BRIDGE 20 20 40
Susie Q BRIDGE 40 40 0

I would like to view this info in a different way but am not sure how to go
about it. I would like a list of names, each name appearing once and under
the date heading would appear the job that they worked on. Therefore the info
above would look like this:

NAME 18/6/07 25/6/07 2/7/07
Joe Bloggs ROAD ROAD ROAD
Charlie Brown ROAD, BRIDGE ROAD, BRIDGE BRIDGE
Susie Q BRIDGE BRIDGE ROAD

I don't want to use another sheet with formulas as it would be really heavy.
I thought running a macro would work but don't know how to do it.

Any help would be appreciated.

Ellen

The following puts your desired data below the existing data. Adapt if
you want it elsewhere.

Hth,
Merjet

Sub Macro1()
Dim c1 As Range
Dim c2 As Range
Dim iRow1 As Long
Dim iRow2 As Long
Dim iRow3 As Long

iRow1 = Range("A1").End(xlDown).Row
iRow2 = iRow1 + 2
Range("A1:A" & iRow1).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A" & iRow2), Unique:=True
Range("C1:E1").Copy Range("C" & iRow2)
iRow3 = Range("A65536").End(xlUp).Row
For Each c2 In Range("A" & iRow2 + 1 & ":A" & iRow3)
For Each c1 In Range("A2:A" & iRow1)
If c1 = c2 Then
For iCol = 3 To 5
If c1.Offset(0, iCol - 1) 0 Then c2.Offset(0, iCol - 1) _
= c2.Offset(0, iCol - 1) & c1.Offset(0, 1) & ", "
Next iCol
End If
Next c1
Next c2
For Each c2 In Range("C" & iRow2 + 1 & ":E" & iRow3)
c2 = Left(c2, Len(c2) - 2) 'clean up -- remove last ", "
Next c2
End Sub

Thanks, i get a compile error saying: method or data member not found



"JLatham" wrote:

Try the following code: test it with a copy of your workbook first, just in
case. The code goes into a regular module: press [Alt]+[F11] to open the VB
Editor then choose Insert | Module from its menu. Copy and paste this code
into it. Edit the definitions for the Const values I've provided to tailor
it to your actual workbook. As currently written, other than the worksheet
names involved, it is set up to work with data laid out as you've shown it
he names in column A starting at row 2, header row in row 1, dates
starting in column C, JOBS named in B. Any of that can be changed, just
one "MUST" that really needs to be followed: the dates must start in a column
to the right of the Names and JOB columns. I've actually tested this here
and it appears to do what you've requested.

Sub BuildByJobsSheet()
'assumptions:
' names are in column A
' Jobs are in column B
' hours worked on a job begin in column C
' dates begin in C1 and go across sheet unbroken
' dates MUST begin AFTER names & jobs
'change these Const values to match sheet names
'that are actually in your workbook

'name of sheet with list to work from
Const srcSheetName = "ByHours"
'name for new arrangement sheet
'sheet does not have to exist
'if it doesn't, it will be created
Const destSheetName = "ByJobs"
'change these to allow for different source sheet
'layouts.
Const nameColumn = "A"
Const jobColumn = "B"
Const firstDateColumn = "C"
' row with dates in it
Const dateRow = 1
' row with first name in it
' MUST be greater than 1
Const firstNameRow = 2

Dim srcSheet As Worksheet
Dim srcRange As Range
Dim srcLastRow As Long
Dim srcLastCol As Long
Dim srcBase As Range

Dim destSheet As Worksheet
Dim destRange As Range
Dim destBase As Range
Dim destLastRow As Long

Dim maxRows As Long
Dim tmpAddress As String
Dim anyCell As Object
Dim ListOfNames() As String
Dim NamesLoop As Long ' loop counter
Dim dateStartOffset As Long
Dim cOffset As Long ' loop counter for date columns
Dim rOffset As Long ' loop counter for names
Dim nameMatchFoundFlag As Boolean

'get proper value for last possible row# on sheet
If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 version of Excel
maxRows = Rows.Count
Else
'in Excel 2007 (or later)
maxRows = Rows.CountLarge
End If

Set srcSheet = Worksheets(srcSheetName)
tmpAddress = Range(nameColumn & firstNameRow).Offset(-1, 0).Address
Set srcBase = srcSheet.Range(tmpAddress)
'test if destination sheet exists
On Error Resume Next
Set destSheet = Worksheets(destSheetName)
If Err < 0 Then
'sheet doesn't exist
'create it
Err.Clear
On Error GoTo 0
srcSheet.Copy after:=Sheets(srcSheet.Name)
ActiveSheet.Name = "ByJob"
Set destSheet = ActiveSheet
End If
On Error GoTo 0
'prepare to rebuild new sheet
destSheet.Cells.Clear

tmpAddress = "A" & dateRow & ":" & _
srcSheet.Range("A" & dateRow).End(xlToRight).Address
Set srcRange = srcSheet.Range(tmpAddress)
srcLastCol = srcRange.Columns.Count
If srcLastCol < 3 Then
'nothing to do, no dates on source sheet!
Set srcRange = Nothing
Set srcSheet = Nothing
Exit Sub
End If
Application.ScreenUpdating = False
Set destRange = destSheet.Range(tmpAddress)
destRange.Value = srcRange.Value
destLastRow = 1
tmpAddress = Range(nameColumn & firstNameRow).Offset(-1, 0).Address
Set destBase = destSheet.Range(tmpAddress)
'get unique names from source sheet, column A
'and place into dynamic array ListOfNames()
'initialize and seed the array
ReDim ListOfNames(1 To 1)
ListOfNames(1) = srcSheet.Range(nameColumn & firstNameRow).Value

'assume continuous list of names
srcLastRow = srcSheet.Range(nameColumn & _
maxRows).End(xlUp).Row
'another test for anything to do
If srcLastRow < firstNameRow Then
'nothing to do, no names on source sheet!
Set srcRange = Nothing
Set srcSheet = Nothing
Application.ScreenUpdating = True
Exit Sub
End If

'pick up names and place one copy of
'each unique name into array ListOfNames()
Set srcRange = srcSheet.Range(nameColumn & firstNameRow & ":" _
& nameColumn & srcLastRow)
For Each anyCell In srcRange
nameMatchFoundFlag = False
For NamesLoop = LBound(ListOfNames) To _
UBound(ListOfNames)
If UCase(Trim(anyCell.Value)) = _
UCase(Trim(ListOfNames(NamesLoop))) Then
nameMatchFoundFlag = True
Exit For
End If
Next
If Not (nameMatchFoundFlag) Then
'new name, add to list
'if the cell is not empty
If Not IsEmpty(anyCell) Then
ReDim Preserve ListOfNames(1 To _
UBound(ListOfNames) + 1)
ListOfNames(UBound(ListOfNames)) = anyCell.Value
End If ' empty cell test
End If ' new name test
Next
'firstDateColumn
dateStartOffset = _
Range(firstDateColumn & 1).Column - srcBase.Column
'
'The real work begins
'for each name in ListOfNames()
'find name on source sheet, and for each
'date column, find out if they worked on a job
'and if they did, build up string JobsWorked
'to be placed on the destination sheet in proper column
'
For NamesLoop = LBound(ListOfNames) To UBound(ListOfNames)
destBase.Offset(NamesLoop, 0) = ListOfNames(NamesLoop)
For rOffset = 1 To srcLastRow - 1
For cOffset = dateStartOffset To srcLastCol - 1
'test if names match
If UCase(Trim(srcBase.Offset(rOffset, 0))) = _
UCase(Trim(ListOfNames(NamesLoop))) Then
'test if hours 0
If srcBase.Offset(rOffset, cOffset) 0 Then
destBase.Offset(NamesLoop, cOffset) = _
destBase.Offset(NamesLoop, cOffset) & " " & _
srcBase.Offset(rOffset, 1).Value
End If 'hours worked test
End If ' name match test
Next ' cOffset loop end
Next ' rOffset loop end
Next ' NamesLoop loop end
'get rid of JOBS column in new sheet
destSheet.Range(jobColumn & 1).EntireColumn.Delete
'release resources
Set srcRange = Nothing
Set srcBase = Nothing
Set srcSheet = Nothing
Set destBase = Nothing
Set destRange = Nothing
Set destSheet = Nothing
Application.ScreenUpdating = True
End Sub


"ellebelle" wrote:

I have info in a spreadsheet that outlines the hours per week that a person
spends on a particular job. eg.


NAME JOB 18/6/07 25/6/07 2/7/07
Joe Bloggs ROAD 40 40 40
Charlie Brown ROAD 20 20 0
Susie Q ROAD 0 0 40
Charlie Brown BRIDGE 20 20 40
Susie Q BRIDGE 40 40 0

I would like to view this info in a different way but am not sure how to go
about it. I would like a list of names, each name appearing once and under
the date heading would appear the job that they worked on. Therefore the info
above would look like this:

NAME 18/6/07 25/6/07 2/7/07
Joe Bloggs ROAD ROAD ROAD
Charlie Brown ROAD, BRIDGE ROAD, BRIDGE BRIDGE
Susie Q BRIDGE BRIDGE ROAD

I don't want to use another sheet with formulas as it would be really heavy.
I thought running a macro would work but don't know how to do it.

Any help would be appreciated.

Ellen

thanks but with this code i get an error saying: block if without end if

"merjet" wrote:

The following puts your desired data below the existing data. Adapt if
you want it elsewhere.

Hth,
Merjet

Sub Macro1()
Dim c1 As Range
Dim c2 As Range
Dim iRow1 As Long
Dim iRow2 As Long
Dim iRow3 As Long

iRow1 = Range("A1").End(xlDown).Row
iRow2 = iRow1 + 2
Range("A1:A" & iRow1).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A" & iRow2), Unique:=True
Range("C1:E1").Copy Range("C" & iRow2)
iRow3 = Range("A65536").End(xlUp).Row
For Each c2 In Range("A" & iRow2 + 1 & ":A" & iRow3)
For Each c1 In Range("A2:A" & iRow1)
If c1 = c2 Then
For iCol = 3 To 5
If c1.Offset(0, iCol - 1) 0 Then c2.Offset(0, iCol - 1) _
= c2.Offset(0, iCol - 1) & c1.Offset(0, 1) & ", "
Next iCol
End If
Next c1
Next c2
For Each c2 In Range("C" & iRow2 + 1 & ":E" & iRow3)
c2 = Left(c2, Len(c2) - 2) 'clean up -- remove last ", "
Next c2
End Sub

thanks but with this code i get an error saying: block if without end if

It works for me, so you must have not copied it correctly. There is
only one If...End If block in the code. The code of the form 'If X
Then Y' on one line doesn't need an 'End If'.

Hth,
Merjet

Hi, This is working well now. THank you! Onl;y one hitch. It only lists the
jobs for a single week. I would like a table for all jobs over all teh weeks
in the original table. Is that possible?



"JLatham" wrote:

Try the following code: test it with a copy of your workbook first, just in
case. The code goes into a regular module: press [Alt]+[F11] to open the VB
Editor then choose Insert | Module from its menu. Copy and paste this code
into it. Edit the definitions for the Const values I've provided to tailor
it to your actual workbook. As currently written, other than the worksheet
names involved, it is set up to work with data laid out as you've shown it
he names in column A starting at row 2, header row in row 1, dates
starting in column C, JOBS named in B. Any of that can be changed, just
one "MUST" that really needs to be followed: the dates must start in a column
to the right of the Names and JOB columns. I've actually tested this here
and it appears to do what you've requested.

Sub BuildByJobsSheet()
'assumptions:
' names are in column A
' Jobs are in column B
' hours worked on a job begin in column C
' dates begin in C1 and go across sheet unbroken
' dates MUST begin AFTER names & jobs
'change these Const values to match sheet names
'that are actually in your workbook

'name of sheet with list to work from
Const srcSheetName = "ByHours"
'name for new arrangement sheet
'sheet does not have to exist
'if it doesn't, it will be created
Const destSheetName = "ByJobs"
'change these to allow for different source sheet
'layouts.
Const nameColumn = "A"
Const jobColumn = "B"
Const firstDateColumn = "C"
' row with dates in it
Const dateRow = 1
' row with first name in it
' MUST be greater than 1
Const firstNameRow = 2

Dim srcSheet As Worksheet
Dim srcRange As Range
Dim srcLastRow As Long
Dim srcLastCol As Long
Dim srcBase As Range

Dim destSheet As Worksheet
Dim destRange As Range
Dim destBase As Range
Dim destLastRow As Long

Dim maxRows As Long
Dim tmpAddress As String
Dim anyCell As Object
Dim ListOfNames() As String
Dim NamesLoop As Long ' loop counter
Dim dateStartOffset As Long
Dim cOffset As Long ' loop counter for date columns
Dim rOffset As Long ' loop counter for names
Dim nameMatchFoundFlag As Boolean

'get proper value for last possible row# on sheet
If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 version of Excel
maxRows = Rows.Count
Else
'in Excel 2007 (or later)
maxRows = Rows.CountLarge
End If

Set srcSheet = Worksheets(srcSheetName)
tmpAddress = Range(nameColumn & firstNameRow).Offset(-1, 0).Address
Set srcBase = srcSheet.Range(tmpAddress)
'test if destination sheet exists
On Error Resume Next
Set destSheet = Worksheets(destSheetName)
If Err < 0 Then
'sheet doesn't exist
'create it
Err.Clear
On Error GoTo 0
srcSheet.Copy after:=Sheets(srcSheet.Name)
ActiveSheet.Name = "ByJob"
Set destSheet = ActiveSheet
End If
On Error GoTo 0
'prepare to rebuild new sheet
destSheet.Cells.Clear

tmpAddress = "A" & dateRow & ":" & _
srcSheet.Range("A" & dateRow).End(xlToRight).Address
Set srcRange = srcSheet.Range(tmpAddress)
srcLastCol = srcRange.Columns.Count
If srcLastCol < 3 Then
'nothing to do, no dates on source sheet!
Set srcRange = Nothing
Set srcSheet = Nothing
Exit Sub
End If
Application.ScreenUpdating = False
Set destRange = destSheet.Range(tmpAddress)
destRange.Value = srcRange.Value
destLastRow = 1
tmpAddress = Range(nameColumn & firstNameRow).Offset(-1, 0).Address
Set destBase = destSheet.Range(tmpAddress)
'get unique names from source sheet, column A
'and place into dynamic array ListOfNames()
'initialize and seed the array
ReDim ListOfNames(1 To 1)
ListOfNames(1) = srcSheet.Range(nameColumn & firstNameRow).Value

'assume continuous list of names
srcLastRow = srcSheet.Range(nameColumn & _
maxRows).End(xlUp).Row
'another test for anything to do
If srcLastRow < firstNameRow Then
'nothing to do, no names on source sheet!
Set srcRange = Nothing
Set srcSheet = Nothing
Application.ScreenUpdating = True
Exit Sub
End If

'pick up names and place one copy of
'each unique name into array ListOfNames()
Set srcRange = srcSheet.Range(nameColumn & firstNameRow & ":" _
& nameColumn & srcLastRow)
For Each anyCell In srcRange
nameMatchFoundFlag = False
For NamesLoop = LBound(ListOfNames) To _
UBound(ListOfNames)
If UCase(Trim(anyCell.Value)) = _
UCase(Trim(ListOfNames(NamesLoop))) Then
nameMatchFoundFlag = True
Exit For
End If
Next
If Not (nameMatchFoundFlag) Then
'new name, add to list
'if the cell is not empty
If Not IsEmpty(anyCell) Then
ReDim Preserve ListOfNames(1 To _
UBound(ListOfNames) + 1)
ListOfNames(UBound(ListOfNames)) = anyCell.Value
End If ' empty cell test
End If ' new name test
Next
'firstDateColumn
dateStartOffset = _
Range(firstDateColumn & 1).Column - srcBase.Column
'
'The real work begins
'for each name in ListOfNames()
'find name on source sheet, and for each
'date column, find out if they worked on a job
'and if they did, build up string JobsWorked
'to be placed on the destination sheet in proper column
'
For NamesLoop = LBound(ListOfNames) To UBound(ListOfNames)
destBase.Offset(NamesLoop, 0) = ListOfNames(NamesLoop)
For rOffset = 1 To srcLastRow - 1
For cOffset = dateStartOffset To srcLastCol - 1
'test if names match
If UCase(Trim(srcBase.Offset(rOffset, 0))) = _
UCase(Trim(ListOfNames(NamesLoop))) Then
'test if hours 0
If srcBase.Offset(rOffset, cOffset) 0 Then
destBase.Offset(NamesLoop, cOffset) = _
destBase.Offset(NamesLoop, cOffset) & " " & _
srcBase.Offset(rOffset, 1).Value
End If 'hours worked test
End If ' name match test
Next ' cOffset loop end
Next ' rOffset loop end
Next ' NamesLoop loop end
'get rid of JOBS column in new sheet
destSheet.Range(jobColumn & 1).EntireColumn.Delete
'release resources
Set srcRange = Nothing
Set srcBase = Nothing
Set srcSheet = Nothing
Set destBase = Nothing
Set destRange = Nothing
Set destSheet = Nothing
Application.ScreenUpdating = True
End Sub


"ellebelle" wrote:

I have info in a spreadsheet that outlines the hours per week that a person
spends on a particular job. eg.


NAME JOB 18/6/07 25/6/07 2/7/07
Joe Bloggs ROAD 40 40 40
Charlie Brown ROAD 20 20 0
Susie Q ROAD 0 0 40
Charlie Brown BRIDGE 20 20 40
Susie Q BRIDGE 40 40 0

I would like to view this info in a different way but am not sure how to go
about it. I would like a list of names, each name appearing once and under
the date heading would appear the job that they worked on. Therefore the info
above would look like this:

NAME 18/6/07 25/6/07 2/7/07
Joe Bloggs ROAD ROAD ROAD
Charlie Brown ROAD, BRIDGE ROAD, BRIDGE BRIDGE
Susie Q BRIDGE BRIDGE ROAD

I don't want to use another sheet with formulas as it would be really heavy.
I thought running a macro would work but don't know how to do it.

Any help would be appreciated.

Ellen