Count to Table Format

[MCheru]

Macro#1

Sub CountTripleColumnsToTableFormat()
Dim LC As Long, LRA As Long, LRC As Long
Application.ScreenUpdating = False
LRA = Cells(Rows.Count, "A").End(xlUp).Row
Range("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1"),
Unique:=True
With Range(Cells(2, "D"), Cells(Rows.Count, "D").End(xlUp))
.Copy
Range("D1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
.ClearContents
Application.CutCopyMode = False
End With
Cells.Columns.AutoFit
Columns("D:E").Insert Shift:=xlToRight
Range("A1:B" & LRA).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range("D2"), Unique:=True
If Range("D2").Value = Range("D3").Value Then Range("D3:E3").Delete
(xlShiftUp)
Range("Extract").Name.Delete
LRC = Range("D" & Rows.Count).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
With Range("F2", Cells(LRC, LC))
.FormulaR1C1 = "=SUMPRODUCT(--(R1C1:R" & LRA & "C1=RC4),--(R1C2:R" & LRA
& "C2=RC5),--(R1C3:R" & LRA & "C3=R1C))"
.Value = .Value
.NumberFormat = "General;;"
.HorizontalAlignment = xlCenter
End With
Columns("A:C").Delete Shift:=xlToLeft
Range("C2").Select
Application.ScreenUpdating = True
End Sub


Macro #2

Sub aaa()
Dim DataSH As Worksheet, WrkSH As Worksheet
Set DataSH = Sheets("Sheet1")
Application.ScreenUpdating = False
With Sheets.Add
.Name = "Working"
End With
Set WrkSH = Sheets("Working")
WrkSH.Range("A11").Value = DataSH.Range("A11").Value
DataSH.Range("A:C").AdvancedFilter action:=xlFilterCopy,
copytorange:=WrkSH.Range("A1:C1"), unique:=True
lastrow = DataSH.Cells(Rows.Count, 1).End(xlUp).Row
With WrkSH
.Range("D2").Formula = "=SUMPRODUCT(--(Sheet1!$A$2:$A$" & lastrow &
"=A2),--(Sheet1!$B$2:$B$" & lastrow & "=B2),--(Sheet1!$C$2:$C$" & lastrow &
"=C2), (Sheet1!$D$2:$D$" & lastrow & "))"
.Range("D2").AutoFill Destination:=.Range("D2" & .Cells(Rows.Count,
1).End(xlUp).Row)

End With

DataSH.Range("A").Value = WrkSH.Range("A").Value
Application.DisplayAlerts = False
WrkSH.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


I am trying to get Sheet1 to look like Sheet2 (see below). Macro #1 (see
above) could do the job if I was not trying to include totals from Column D,
whereas Macro #2 (see above), can count up Column D but it cannot display the
data how it is displayed in Sheet2. I am trying to get Sheet1 to look like
Sheet2. Any help is appreciated.

Sheet1
A
B C D
00007777 SHT1 06/01/2009 2.6
00007777 WBK1 06/01/2009 4.2
00007777 WBK3 06/01/2009 2
00007123 WBK3 06/01/2009 1.3
00007888 SHT1 06/01/2009 7
00009991 SHT1 06/01/2009 2.5
00002112 WBK1 06/01/2009 1
00003029 SHT1 06/01/2009 3
00001111 SHT1 06/01/2009 8.2
00001111 SHT4 06/01/2009 1
00002222 SHT2 06/01/2009 3
00002222 WBK1 06/01/2009 5
05802758 SHT2 06/01/2009 3
00007777 SHT2 06/02/2009 1
00007777 WBK1 06/02/2009 1
00007123 WBK4 06/02/2009 3
00007888 SHT1 06/02/2009 6.6
00009991 SHT1 06/02/2009 1
00002112 WBK1 06/02/2009 1
00003029 SHT1 06/02/2009 4.6
00001111 SHT1 06/02/2009 8
00001111 SHT2 06/02/2009 7.6
00009065 WBK4 06/02/2009 1
00009065 WBK7 06/02/2009 2
00003333 SHT2 06/02/2009 4
05802758 SHT2 06/02/2009 3
05960709 SHT2 06/02/2009 5
00007777 WBK1 06/03/2009 0.6
00007777 WBK3 06/03/2009 3.6
00007123 SHT2 06/03/2009 0.6
00007123 WBK4 06/03/2009 2.4
00007888 SHT1 06/03/2009 8
00007989 WBK1 06/03/2009 0.1
00002112 SHT2 06/03/2009 1
00002112 WBK1 06/03/2009 1.5
00003029 SHT1 06/03/2009 5
00001111 SHT2 06/03/2009 5
00001111 WBK2 06/03/2009 1
00009065 WBK2 06/03/2009 1
00009065 WBK4 06/03/2009 0.6
00009065 WBK7 06/03/2009 2.2
00002222 SHT4 06/03/2009 7
00002222 WBK7 06/03/2009 4
00003333 SHT2 06/03/2009 1
05802758 SHT2 06/03/2009 2
05960709 SHT2 06/03/2009 3


Sheet2

A B C D E
06/01/2009 06/02/2009 06/03/2009
00000001 SHT2
WBK7
WBK9
00001111 SHT1 8.2 8
SHT2 7.6 5
SHT4 1
WBK1
WBK2 1
WBK3
WBK4
WBK7
00002112 SHT1
SHT2 1
SHT5
WBK1 1 1 1.5
WBK2
WBK3
WBK6
00002222 SHT1
SHT2 3
SHT4 7
WBK1 5
WBK2
WBK3
WBK5
WBK7 4
00003029 SHT1 3 4.6 5
SHT4
00003333 SHT2 4 1
00006999 SHT1
SHT4
00007123 SHT2 0.6
WBK2
WBK3 1.3
WBK4 3 2.4
WBK7
00007654 SHT1
SHT2
SHT3
WBK1
WBK2
WBK3
WBK4
WBK5
WBK7
00007777 SHT1 2.6
SHT2 1
WBK1 4.2 1 0.6
WBK2
WBK3 2 3.6
WBK4
WBK5
WBK7
00007888 SHT1 7 6.6 8
SHT2
SHT4
WBK7
00007989 SHT2
WBK1 0.1
WBK3
WBK4
00008888 SHT1
SHT2
SHT3
WBK1
WBK2
WBK3
WBK4
WBK6
WBK7
00009065 WBK1
WBK2 1
WBK3
WBK4 1 0.6
WBK7 2 2.2
00009991 SHT1 2.5 1
SHT2
WBK1
WBK3
WBK4
WBK7
05802758 SHT2 3 3 2
WBK1
05960709 SHT2 5 3
05961026 SHT2