|
|
"Summary" Worksheet A B C 1. Project Crit ProjCrit 2. Bravo 1 Bravo1 3. Bravo 1 Bravo1 4. Bravo 1 Bravo1 5. Bravo 2 Bravo2 6. Bravo 2 Bravo2 7. Bravo 3 Bravo3 8. Delta 2 Delta2 9. Delta 2 Delta2
wanted "PoStatus" Worksheet after following code execution to summarize Projects by Criteria count A B C D 1. Project Crit1 Crit2 Crit3 2. Bravo 3 2 1 3. Delta 2
Sub PoStatus() ActiveWorkbook.Sheets("Summary").Select Dim i As Integer: Dim j As Integer: Dim k As Integer Dim RngA As Range: Dim RngB As Range: Dim RngC As Range Columns("A:C").Select Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom i = 2: k = 2 Set RngA = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp)) Set RngB = Range(Cells(1, "B"), Cells(Rows.Count, "B").End(xlUp)) Set RngC = Range(Cells(1, "C"), Cells(Rows.Count, "C").End(xlUp)) ' Calculate Sums for PO in Summary Do While i <= Range("A65000").End(xlUp).Row j = Application.CountIf(RngA, Cells(i, "A")) Worksheets("PoStatus").Cells(k, "A") = Cells(i, "A") l= Application.CountIf(RngC, Cells(i, "C")) Do While l <= j l= Application.CountIf(RngC, Cells(i, "C")) Select Case Cells(i,"B") Case "1" Worksheets("PoStatus").Cells(k, "B") = l Case "2" Worksheets("PoStatus").Cells(k, "C") = l Case "3" Worksheets("PoStatus").Cells(k, "D") = l End Select l = l +i : i = i + l ' suspected logic error there Loop k = k + 1 Loop ActiveWorkbook.Sheets("PoStatus").Select End Sub The desired worksheet result does properly populate. Help appreciated, J.P.
|
|
This is a perfect layout to use a pivottable.
If you want to try...
Select your range (A1:C9). Data|Pivottable (in xl2003 menus) Follow the wizard until you get to a dialog with a Layout button on it. Click that Layout button. Drag the project header to the row field drag the crit header to the column field drag the projcrit header to the data field
Finish up the wizard.
u473 wrote:
[Quoted Text] > > "Summary" Worksheet > A B C > 1. Project Crit ProjCrit > 2. Bravo 1 Bravo1 > 3. Bravo 1 Bravo1 > 4. Bravo 1 Bravo1 > 5. Bravo 2 Bravo2 > 6. Bravo 2 Bravo2 > 7. Bravo 3 Bravo3 > 8. Delta 2 Delta2 > 9. Delta 2 Delta2 > > wanted "PoStatus" Worksheet after following code execution > to summarize Projects by Criteria count > A B C D > 1. Project Crit1 Crit2 Crit3 > 2. Bravo 3 2 1 > 3. Delta 2 > > Sub PoStatus() > ActiveWorkbook.Sheets("Summary").Select > Dim i As Integer: Dim j As Integer: Dim k As Integer > Dim RngA As Range: Dim RngB As Range: Dim RngC As Range > Columns("A:C").Select > Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, > Header:=xlGuess, OrderCustom:=1, MatchCase:=False, > Orientation:=xlTopToBottom > i = 2: k = 2 > Set RngA = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp)) > Set RngB = Range(Cells(1, "B"), Cells(Rows.Count, "B").End(xlUp)) > Set RngC = Range(Cells(1, "C"), Cells(Rows.Count, "C").End(xlUp)) > ' Calculate Sums for PO in Summary > Do While i <= Range("A65000").End(xlUp).Row > j = Application.CountIf(RngA, Cells(i, "A")) > Worksheets("PoStatus").Cells(k, "A") = Cells(i, "A") > l= Application.CountIf(RngC, Cells(i, "C")) > Do While l <= j > l= Application.CountIf(RngC, Cells(i, "C")) > Select Case Cells(i,"B") > Case "1" > Worksheets("PoStatus").Cells(k, "B") = l > Case "2" > Worksheets("PoStatus").Cells(k, "C") = l > Case "3" > Worksheets("PoStatus").Cells(k, "D") = l > End Select > l = l +i : i = i + l ' suspected logic error there > Loop > k = k + 1 > Loop > ActiveWorkbook.Sheets("PoStatus").Select > End Sub > The desired worksheet result does properly populate. > Help appreciated, > J.P.
--
Dave Peterson
|
|
If you want to read more about pivottables...
Here are a few links:
Debra Dalgleish's pictures at Jon Peltier's site: http://peltiertech.com/Excel/Pivots/pivottables.htm And Debra's own site: http://www.contextures.com/xlPivot01.html
John Walkenbach also has some at: http://j-walk.com/ss/excel/files/general.htm (look for Tony Gwynn's Hit Database)
Chip Pearson keeps Harald Staff's notes at: http://www.cpearson.com/excel/pivots.htm
MS has some at (xl2000 and xl2002): http://office.microsoft.com/downloads/2000/XCrtPiv.aspx http://office.microsoft.com/assistance/2002/articles/xlconPT101.aspx
u473 wrote:
[Quoted Text] > > "Summary" Worksheet > A B C > 1. Project Crit ProjCrit > 2. Bravo 1 Bravo1 > 3. Bravo 1 Bravo1 > 4. Bravo 1 Bravo1 > 5. Bravo 2 Bravo2 > 6. Bravo 2 Bravo2 > 7. Bravo 3 Bravo3 > 8. Delta 2 Delta2 > 9. Delta 2 Delta2 > > wanted "PoStatus" Worksheet after following code execution > to summarize Projects by Criteria count > A B C D > 1. Project Crit1 Crit2 Crit3 > 2. Bravo 3 2 1 > 3. Delta 2 > > Sub PoStatus() > ActiveWorkbook.Sheets("Summary").Select > Dim i As Integer: Dim j As Integer: Dim k As Integer > Dim RngA As Range: Dim RngB As Range: Dim RngC As Range > Columns("A:C").Select > Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, > Header:=xlGuess, OrderCustom:=1, MatchCase:=False, > Orientation:=xlTopToBottom > i = 2: k = 2 > Set RngA = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp)) > Set RngB = Range(Cells(1, "B"), Cells(Rows.Count, "B").End(xlUp)) > Set RngC = Range(Cells(1, "C"), Cells(Rows.Count, "C").End(xlUp)) > ' Calculate Sums for PO in Summary > Do While i <= Range("A65000").End(xlUp).Row > j = Application.CountIf(RngA, Cells(i, "A")) > Worksheets("PoStatus").Cells(k, "A") = Cells(i, "A") > l= Application.CountIf(RngC, Cells(i, "C")) > Do While l <= j > l= Application.CountIf(RngC, Cells(i, "C")) > Select Case Cells(i,"B") > Case "1" > Worksheets("PoStatus").Cells(k, "B") = l > Case "2" > Worksheets("PoStatus").Cells(k, "C") = l > Case "3" > Worksheets("PoStatus").Cells(k, "D") = l > End Select > l = l +i : i = i + l ' suspected logic error there > Loop > k = k + 1 > Loop > ActiveWorkbook.Sheets("PoStatus").Select > End Sub > The desired worksheet result does properly populate. > Help appreciated, > J.P.
--
Dave Peterson
|
|
I would seem to me that it would be FAR simpler to use a Pivot Table...
In article <511acb05-e5a7-4390-913b-164439fea150[ at ]k9g2000vbl.googlegroups.com>, u473 <u473[ at ]aol.com> wrote:
[Quoted Text] > "Summary" Worksheet > A B C > 1. Project Crit ProjCrit > 2. Bravo 1 Bravo1 > 3. Bravo 1 Bravo1 > 4. Bravo 1 Bravo1 > 5. Bravo 2 Bravo2 > 6. Bravo 2 Bravo2 > 7. Bravo 3 Bravo3 > 8. Delta 2 Delta2 > 9. Delta 2 Delta2 > > wanted "PoStatus" Worksheet after following code execution > to summarize Projects by Criteria count > A B C D > 1. Project Crit1 Crit2 Crit3 > 2. Bravo 3 2 1 > 3. Delta 2 > > Sub PoStatus() > ActiveWorkbook.Sheets("Summary").Select > Dim i As Integer: Dim j As Integer: Dim k As Integer > Dim RngA As Range: Dim RngB As Range: Dim RngC As Range > Columns("A:C").Select > Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, > Header:=xlGuess, OrderCustom:=1, MatchCase:=False, > Orientation:=xlTopToBottom > i = 2: k = 2 > Set RngA = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp)) > Set RngB = Range(Cells(1, "B"), Cells(Rows.Count, "B").End(xlUp)) > Set RngC = Range(Cells(1, "C"), Cells(Rows.Count, "C").End(xlUp)) > ' Calculate Sums for PO in Summary > Do While i <= Range("A65000").End(xlUp).Row > j = Application.CountIf(RngA, Cells(i, "A")) > Worksheets("PoStatus").Cells(k, "A") = Cells(i, "A") > l= Application.CountIf(RngC, Cells(i, "C")) > Do While l <= j > l= Application.CountIf(RngC, Cells(i, "C")) > Select Case Cells(i,"B") > Case "1" > Worksheets("PoStatus").Cells(k, "B") = l > Case "2" > Worksheets("PoStatus").Cells(k, "C") = l > Case "3" > Worksheets("PoStatus").Cells(k, "D") = l > End Select > l = l +i : i = i + l ' suspected logic error there > Loop > k = k + 1 > Loop > ActiveWorkbook.Sheets("PoStatus").Select > End Sub > The desired worksheet result does properly populate. > Help appreciated, > J.P.
|
|
Thank you, I know how handle Pivot table, in this case I want to master VBA logic J.P.
|
|
|