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

"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/assistan...lconPT101.aspx

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

I would seem to me that it would be FAR simpler to use a Pivot Table...



In article
,
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.

Thank you, I know how handle Pivot table, in this case I want to
master VBA logic
J.P.

Your logic was correct, but the way you implemented it was not. When you
added i to l, this gave you a new value for l. Then you added that new value
to i. you need to add the old value of l to i. You had not declared l, so I
added that and another for Oldl to hold the original value of l so you could
add that to i. Also, j was not quite correct. Once you set the value of j
with the CountIf, you needed to add 1 for the header row. Here is the
modified code:

Sub PoStatus()
ActiveWorkbook.Sheets("Summary").Select
Dim i As Integer: Dim j As Integer: Dim k As Integer
Dim l As Integer, Oldl 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 + 1 'add 1 for header
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
Oldl = l
l = l + i: i = i + Oldl ' suspected logic error there
Loop
k = k + 1
Loop
ActiveWorkbook.Sheets("PoStatus").Select
End Sub

Mike F
"u473" wrote in message
...
"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.

In that case then, here is a macro that I think does what you asked for...

Sub PoStatus()
Dim X As Long, Y As Long
Dim Data As Variant
Dim PoData() As Variant
Dim LastRow As Long
Dim MaxCrit As Long
Dim MaxProjects As Long
Dim UniqueProjectNames As New Collection
Const DataStartRow As Long = 2
With Worksheets("Summary")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Data = .Range("A" & DataStartRow & ":C" & LastRow)
On Error Resume Next
For X = DataStartRow To LastRow
UniqueProjectNames.Add .Cells(X, "A").Value, .Cells(X, "A").Value
Next
On Error GoTo 0
MaxCrit = WorksheetFunction.Max(.Range("B:B"))
MaxProjects = UniqueProjectNames.Count
ReDim PoData(1 To MaxProjects, 1 To MaxCrit + 1)
For X = 1 To MaxProjects
PoData(X, 1) = UniqueProjectNames(X)
Next
For Y = 1 To MaxProjects
For X = 2 To LastRow
If PoData(Y, 1) = .Cells(X, "A") Then
PoData(Y, .Cells(X, "B") + 1) = PoData(Y, .Cells(X, "B") + 1) + 1
End If
Next
Next
End With
With Worksheets("PoStatus")
.Range("A1").Value = "Project"
For X = 1 To MaxCrit
.Cells(1, X + 1).Value = "Crit" & X
Next
.Range("A2").Resize(MaxProjects, MaxCrit + 1) = PoData
End With
End Sub

--
Rick (MVP - Excel)


"u473" wrote in message
...
Thank you, I know how handle Pivot table, in this case I want to
master VBA logic
J.P.