U
u473
I am trying to summarize Purchase Orders by Project and Vendor
from POSummary into VendorSummary
..
Source WorkSheet POSummary
A B C D
Project PO# Vendor PO Value
693 56 Alpha 1,000
693 50 Alpha 2,000
693 54 Bravo 1,000
231 13 Charlie 4,000
231 33 Charlie 2,000
231 23 Bravo 3,000
231 49 Alpha 3,000
231 12 Alpha 5,000
.....
Expected result inDestination VendorSummary
A B C
Project Vendor PO Value
693 Alpha 3,000
693 Bravo 1,000
231 Charlie 6,000
231 Bravo 3,000
231 Alpha 8,000
Somehow, I must have my i's & j's indexes crossed
but I canot find my error.
Help appreciated.
J.P.
Sub Vendor()
Dim i As Integer ' Source Worksheet Current Row Counter
Dim j As Integer ' Criteria Range Counter
Dim k As Integer ' Destination Worksheet Current Row Counter
Dim RngC As Range ' Vendor Range
Dim RngD As Range ' PO Value Range
'
'Sort Source WorkSheet by Project & Vendor
Columns("A").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range("C2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
'
i = 2: k = 2 ' Data start in Row2
Set RngC = Range(Cells(1, "C"), Cells(Rows.Count, "C").End(xlUp))
Set RngD = Range(Cells(1, "D"), Cells(Rows.Count, "D").End(xlUp))
' Calculate Sums by Vendor in VendorSummary
Do While i <= Range("A65000").End(xlUp).Row
j = Application.CountIf(RngC, Cells(i, "C"))
Worksheets("VendorSummary").Cells(k, "A") = Cells(i, "A") '
Project Code
Worksheets("VendorSummary").Cells(k, "B") = Cells(i, "C") ' Vendor
Name
Worksheets("VendorSummary").Cells(k, "C") =
Application.SumIf(RngD, Cells(i, "C"), RngD)
k = k + 1: i = i + j
Loop
End Sub
from POSummary into VendorSummary
..
Source WorkSheet POSummary
A B C D
Project PO# Vendor PO Value
693 56 Alpha 1,000
693 50 Alpha 2,000
693 54 Bravo 1,000
231 13 Charlie 4,000
231 33 Charlie 2,000
231 23 Bravo 3,000
231 49 Alpha 3,000
231 12 Alpha 5,000
.....
Expected result inDestination VendorSummary
A B C
Project Vendor PO Value
693 Alpha 3,000
693 Bravo 1,000
231 Charlie 6,000
231 Bravo 3,000
231 Alpha 8,000
Somehow, I must have my i's & j's indexes crossed
but I canot find my error.
Help appreciated.
J.P.
Sub Vendor()
Dim i As Integer ' Source Worksheet Current Row Counter
Dim j As Integer ' Criteria Range Counter
Dim k As Integer ' Destination Worksheet Current Row Counter
Dim RngC As Range ' Vendor Range
Dim RngD As Range ' PO Value Range
'
'Sort Source WorkSheet by Project & Vendor
Columns("A").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range("C2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
'
i = 2: k = 2 ' Data start in Row2
Set RngC = Range(Cells(1, "C"), Cells(Rows.Count, "C").End(xlUp))
Set RngD = Range(Cells(1, "D"), Cells(Rows.Count, "D").End(xlUp))
' Calculate Sums by Vendor in VendorSummary
Do While i <= Range("A65000").End(xlUp).Row
j = Application.CountIf(RngC, Cells(i, "C"))
Worksheets("VendorSummary").Cells(k, "A") = Cells(i, "A") '
Project Code
Worksheets("VendorSummary").Cells(k, "B") = Cells(i, "C") ' Vendor
Name
Worksheets("VendorSummary").Cells(k, "C") =
Application.SumIf(RngD, Cells(i, "C"), RngD)
k = k + 1: i = i + j
Loop
End Sub