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:

"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