Converting Messy Data to Pivot Table

[redhots4]

This is a typical report exported into Excel. How do I take data formatted like this and massage it to align in nice, neat columns like the file far below? This is only a sample of the raw data file. In the real world, I woulc have perhaps 25 projects (unique SR numbers) and 50-60 resources, sometimes showing hours worked on multiple projects / SRs.

BEFORE:

Book1.xls
	A	B	C	D	E
6	Manager	A.Manager
7	SRWS060003
8	RESOURCE	Duck,Donald
9
10		Planning		0
11		Analysis		10
12		Design		20
13		Construction		10
14		Testing		0
15		Deployment		0
16
17	RESOURCE	Mouse,Mickey
18
19		Planning		0
20		Analysis		0
21		Design		35
22		Construction		10
23		Testing		0
24		Deployment		0
25
26	SRWS060004
27	RESOURCE	Goofy,Dawg
28
29		Planning		0
30		Analysis		25
31		Design		10
32		Construction		10
33		Testing		0
34		Deployment		0
Sheet1

AFTER:

Book1.xls
	A	B	C	D	E	F	G	H	I
1	SR	Resource	DateEnd	Planning	Analysis	Design	Construction	Testing	Deployment
2	WS060003	Duck,Donald	8/8/2006	0	10	20	10	0	0
3	WS060003	Mouse,Mickey	8/8/2006	0	0	35	10	0	0
4	WS060004	Goofy,Dawg	8/8/2006	0	25	10	10	0	0
5
Sheet2

 

[acw]

Hi

The following code will manipulate the data on the current sheet, then build a pivot table starting in F6.

Sub ccc()
  Range("A6").Value = "SR"
  Range("B6").Value = "RESOURCE"
  Range("D6").Value = "DEPARTMENT"
  Range("E6").Value = "HOURS"
  Range("A:A").Replace what:="SR ", replacement:=""
  Range("A:A").Replace what:="RESOURCE", replacement:=""
  Columns("C:C").Delete
  lastrow = Cells(Rows.Count, 3).End(xlUp).Row
  Range("A8:A" & lastrow).SpecialCells(xlCellTypeBlanks).Formula = "=A7"
  Range("B9:B" & lastrow).SpecialCells(xlCellTypeBlanks).Formula = "=B8"
  Range("A:B").Value = Range("A:B").Value
  For i = lastrow To 7 Step -1
    If IsEmpty(Cells(i, 3)) Then Cells(i, 3).EntireRow.Delete
  Next i
  lastrow = Cells(Rows.Count, 3).End(xlUp).Row
  
  ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        ActiveSheet.Name & "!R6C1:R" & lastrow & "C4").CreatePivotTable TableDestination:=ActiveSheet.Name & "!R6C6" _
        , TableName:="Output", DefaultVersion:=xlPivotTableVersion10
    With ActiveSheet.PivotTables("Output").PivotFields("SR")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Output").PivotFields("RESOURCE")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("Output").PivotFields("DEPARTMENT")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Output").AddDataField ActiveSheet.PivotTables( _
        "Output").PivotFields("HOURS"), "Sum of HOURS", xlSum
    
    ActiveSheet.PivotTables("Output").PivotFields("RESOURCE").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    ActiveSheet.PivotTables("Output").PivotFields("SR").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    
    With ActiveSheet.PivotTables("Output")
        .ColumnGrand = False
        .RowGrand = False
    End With
  
  
End Sub

HTH

Tony

 

[agihcam]

also try;

Sub test()
Application.ScreenUpdating = False
Columns("c:d").Insert shift:=xlToRight
Dim i, ii As Long
For i = 6 To Range("b" & Rows.Count).End(xlUp).Row
If Cells(i, "a") Like "SR*" Then
Cells(i, "c") = Cells(i, "a")
End If
If Cells(i, "a") = "RESOURCE" Then
Cells(i, "d") = Cells(i, "b")
End If
Cells(i, "e") = 1
Next

Range("e7").Activate
Do While ActiveCell.Value<> ""
If ActiveCell.Offset(1, -2) = "" Then
ActiveCell.Offset(1, -2).Value = ActiveCell.Offset(, -2).Value
End If

If ActiveCell.Offset(1, -1) = "" Then
ActiveCell.Offset(1, -1).Value = ActiveCell.Offset(, -1).Value
End If

ActiveCell.Offset(1).Activate
Loop

'Range("e7").Activate
'Do While ActiveCell.Value<> ""
'If ActiveCell.Offset(1, -1) = "" Then
'ActiveCell.Offset(1, -1).Value = ActiveCell.Offset(, -1).Value
'End If
'ActiveCell.Offset(1).Activate
'Loop

For ii = Range("c" & Rows.Count).End(xlUp).Row To 6 Step -1
If Cells(ii, "f") = "" Then
Rows(ii).Delete
End If
Next
Columns("e").Delete
Range("b5").Resize(, 4) = Array("Analysis", "SR", "Resource", "Qty")


Range("B5:E7").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Sheet3!R5C2:R23C5").CreatePivotTable TableDestination:="", TableName:= _
        "PivotTable2"
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    ActiveSheet.PivotTables("PivotTable2").SmallGrid = False
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("SR")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Resource")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Analysis")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Qty")
        .Orientation = xlDataField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").PivotFields("SR").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    With ActiveSheet.PivotTables("PivotTable2")
        .ColumnGrand = False
        .RowGrand = False
    End With
Application.ScreenUpdating = True
End Sub

which gives you a result like this in new sheet;

Book1
	A	B	C	D	E	F	G	H
3	Sum of Qty		Analysis
4	SR	Resource	Analysis	Construction	Deployment	Design	Planning	Testing
5	SR WS060003	Duck, Donald	10	10	0	20	0	0
6		Mouse, Mickey	0	10	0	35	0	0
7	SR WS060004	Goofy, Dawg	25	10	0	10	0	0
Sheet18

 

[redhots4]

Realized that the data layout is slightly different than I posted originally. How does this change the macro? Note all of the jazz in the first column.

TINKERING.xls
	A	B	C	D
1
2	REPORTCRITERIA	SRPhaseDetail(Resource)
3
4	Division=DivisionName
5	Inputhourlyrate=$55
6	From08/13/2006to08/19/2006
7
8	SRNumber=WS060003		ACTUAL	PLANNED
9	BusinessDept=ALL,CostCenter=ALL
10		Hours	Cost	Hours
11	SRDEPT(CostAllocationDept)	DepartmentName
12	SRTYPE	2-Strategic
13	SROBJECTIVE	Project
14	SR	WS060003	Project_Name_Here	SRStatus:
15
16	CCDEPARTMENT	CCNAME	CCID
17	DepartmentName	TeamName	B202
18
19	RESOURCE	Last1,First1
20	Definition
21	Analysis
22	Design	10.00	$550.00
23	Coding	20.00	$1,100.00
24	Testing	10.00	$550.00
25	Dcmnt/Training
26	Implement/Post
27	ProjectAdmin.
28	Maintenance
29	TOTALfor	Last1,First1	40.00	$2,200.00
30
Sheet1

 

[acw]

Hi

Bit more than "slightly different"...

Does this example cover all the struture / headings that will occur in a full report?


Tony

 

[redhots4]

Yes, the top rows willbe exactly the same through row 9. Starting in ROW 11, the report will show a heading by SR (Project Number) and then relect resource names and proejct phases in column A. Imagine that in row 31, what you see in rows 11 to 30 will repeat with a different SR and the same or different resource names.

Part of what I'm after here is a standard process used by managers and reporting personnell to extract useful, columned data from reports formatted this way. I need to have predictable columns of data so I can pivot it the way i'd like. I'm sure I'm not the first guy to run aross this issue.

 

[agihcam]

redhots4 -

this codes manipulate the data.

Sub test()
Dim i, ii, iii, lr As Long
Application.ScreenUpdating = False
Range("e13").Resize(, 4) = Array("SR", "Name", "Hours", "Cost")
For i = 14 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(i, "a") = "SR" Then
Cells(i, "e") = Cells(i, "b")
End If
If Cells(i, "a") = "RESOURCE" Then
Cells(i, "f") = Cells(i, "b")
End If

If Cells(i, "b")<> "" Then
Cells(i, "g") = Cells(i, "b")
End If

If Cells(i, "c")<> "" Then
Cells(i, "h") = Cells(i, "c")
End If

Next
Columns("b:d").Delete
Rows("1:12").Delete
[a1] = "Resource"

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(i, "b")<> Cells(i, "b").Offset(1) And Cells(i, "b").Offset(1) = "" Then
Cells(i, "b").Offset(1) = Cells(i, "b")
End If

If Cells(i, "c")<> Cells(i, "c").Offset(1) And Cells(i, "c").Offset(1) = "" Then
Cells(i, "c").Offset(1) = Cells(i, "c")
End If

Next

For iii = Range("b" & Rows.Count).End(xlUp).Row To 2 Step -1
If Cells(iii, "a").Value Like "*Department*" Then
Rows(iii).Delete
End If
If Cells(iii, "a").Value = "TOTAL for" Then
Rows(iii).Delete
End If
If Cells(iii, "a").Value = "RESOURCE" Then
Rows(iii).Delete
End If
If Cells(iii, "a").Value = 0 Then
Rows(iii).Delete
End If
If Cells(iii, "a").Value Like "SR*" Then
Rows(iii).Delete
End If
Next
Cells.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

result will be like this, from here you can do a pivot table.

Book1
	A	B	C	D	E
1	Resource	SR	Name	Hours	Cost
2	Definition	WS060003	Last1, First1
3	Analysis	WS060003	Last1, First1
4	Design	WS060003	Last1, First1	10.00	$550.00
5	Coding	WS060003	Last1, First1	20.00	$1,100.00
6	Testing	WS060003	Last1, First1	10.00	$550.00
7	Dcmnt/Training	WS060003	Last1, First1
8	Implement/Post	WS060003	Last1, First1
9	Project Admin.	WS060003	Last1, First1
10	Maintenance	WS060003	Last1, First1
11	Definition	WS060004	Last2, First2
12	Analysis	WS060004	Last2, First2
13	Design	WS060004	Last2, First2	10.00	$550.00
14	Coding	WS060004	Last2, First2	20.00	$1,100.00
15	Testing	WS060004	Last2, First2	10.00	$550.00
16	Dcmnt/Training	WS060004	Last2, First2
17	Implement/Post	WS060004	Last2, First2
18	Project Admin.	WS060004	Last2, First2
19	Maintenance	WS060004	Last2, First2
Sheet1