"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.