Data in Cross-Tab format: needs to be written in Table Format

[runyan]

I have been beating my brains for days and I cannot figure a way to
write the following Macro.

I have data in the following format in Sheet1:

Date 10/7 10/14 10/21
Name Project

Bill Mow Lawn 80 90 120
Dave Rake Leaves 100 50 400
Susan Weed Shrubs 40 10 12


I am trying to write it to Sheet2 like this:
Date Hours Name Project
10/7 80 Bill Mow Lawn
10/14 90 Bill Mow Lawn
10/21 120 Bill Mow Lawn
10/7 100 Dave Rake Leaves
10/14 50 Dave Rake Leaves
10/21 400 Dave Rake Leaves
10/7 40 Susan Weed Shrubs
10/14 10 Susan Weed Shrubs
10/21 12 Susan Weed Shrubs


Essentially, each row in the cross-tab formatted data (Sheet1) , will
result in many rows in the table format (Sheet2) - one row for each
date value.

1. The location of the project and name columns never changes
2. The number of people and projects do change (needs to loop through
and data values ALWAYS start at C3 and D3)
3. The location of the data row never changes
4. The number of date values do change (nneds to loop through and the
data values ALWAYS start at E2)


I can write a macro that can copy all dates and hours for one
name/project combination, but I cannot figure a way to successfully
loop through the source data and append it to the destination data.


Any help will be greatly appreciated.

Thanks,
Runyan

 

[Patrick Molloy]

this will get you started.
It assumes your dates start at C1 and your names start at A3

Option Explicit
Sub Builder()
Dim cl As Long
Dim rw As Long
Dim user As String
Dim project As String
Dim hours As Long
Dim targetrow As Long
Dim wsTarget As Worksheet

'prepare the results sheet
Set wsTarget = Worksheets("Sheet2")
With wsTarget
.Cells.Clear
.Range("A11") = Array("Date", "Hours", "Name", "Project")
.Range("A11").Font.Bold = True
End With
targetrow = 1

'loop through each user
For rw = 3 To Range("A3").End(xlDown).Row

user = Cells(rw, 1).Value
project = Cells(rw, 2).Value

'loop through each date
For cl = 3 To Range("C1").End(xlToRight).Column

hours = Cells(rw, cl).Value


targetrow = targetrow + 1

With wsTarget

.Cells(targetrow, 1) = Cells(1, cl).Value
.Cells(targetrow, 2) = hours
.Cells(targetrow, 3) = user
.Cells(targetrow, 4) = project

End With


Next


Next

End Sub

 

[Patrick Molloy]

now instead of simply cleainmg the destination sheet you can get the next
available row

with wsTarget
targetrow = .Range("65000").End(xlUp).Row +1
end with