LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 70
Default Count to Table Format


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("A1:D1").Value = DataSH.Range("A1:D1").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:D" & .Cells(Rows.Count,
1).End(xlUp).Row)

End With

DataSH.Range("A:D").Value = WrkSH.Range("A:D").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

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
I need to format a count in a pivot table Golfer2100 Excel Worksheet Functions 2 July 23rd 09 09:17 AM
I tried to get around the problem of the pivot table field settingdefaulting to Count instead of Sum by running a macro of change the settingfrom Count to Sum. However, when I tried to run the Macro, I got error messageof run time error 1004, unable Enda80 Excel Worksheet Functions 1 May 3rd 08 02:35 PM
I tried to get around the problem of the pivot table field settingdefaulting to Count instead of Sum by running a macro of change the settingfrom Count to Sum. However, when I tried to run the Macro, I got error messageof run time error 1004, unable Enda80 Excel Discussion (Misc queries) 1 May 3rd 08 10:52 AM
I tried to get around the problem of the pivot table field settingdefaulting to Count instead of Sum by running a macro of change the settingfrom Count to Sum. However, when I tried to run the Macro, I got error messageof run time error 1004, unable Enda80 Excel Programming 0 May 3rd 08 01:03 AM
Data in Cross-Tab format: needs to be written in Table Format runyan Excel Programming 2 October 4th 05 07:58 AM


All times are GMT +1. The time now is 02:17 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"