On 8 Dec, 19:11, allie357 <allison.mah...@gmail.com> wrote:
> The numbers in this problem may contain letters as well as numbers.
>
> I have a lot of invoice numbers that I need to count. Some are
> associated with a Purchase order number (in some cases multiple
> occurances of the same invoice number are associated with one purchase
> order and sometimes it is different invoices associated with a
> purchase order number.)
>
> First, I need to count the number of unique PO nos. for those where a
> PO number shows up. Then, I need to count the unique invoice numbers
> without a PO number.
>
> I was using the following array formula:
> =SUM(IF(FREQUENCY(IF(LEN(E2:E148)>0,MATCH(E2:E148,E2:E148,0),""), IF
> (LEN(E2:E148)>0,MATCH(E2:E148,E2:E148,0),""))>0,1))
>
> But it doesn't seem to be producing the right results. Here is an
> example of my numbers
> Invoice no. PO Number
> 40701429 763334
> 40701429
> 40701429
> 40701431 768346
> 40701431
> 40701525 763334
> 40701525 763334
> 40701525
> 40701525
> 40701592 748407
> 40701592
> 40701393
>
> 5 invoice numbers 4 po's in the list above is what the answer should
> be in this short example. *How is the best way to get accurate results
> with many numbers? *Thanks!
Phillip London UK
This works for me using your example set of data in columns A and B
in a new workbook
Copy this code into a new sttanard module
Dim Rng As Range
Sub GetUniques()
Dim UniqueInvoice As Long
Dim UniquePO As Long
ResetDB
DoPrimaryKey
ChangeDB
SetResults 1
DoSort "B", 2
DoFilter
UniqueInvoice = WorksheetFunction.CountA(Range("IV:IV")) - 1
Columns("IT:IV").Delete
SetResults 2
ResetDB
DoSort "B", 1
Rng.Columns(2).SpecialCells(xlCellTypeConstants,
xlLogical).ClearContents
DoFilter
UniquePO = WorksheetFunction.CountA(Range("IV:IV")) - 1
Columns("IT:IV").Delete
DoSort "C", 1
Columns("C:C").Delete
MsgBox _
"Number of Unique Invoices : " & UniqueInvoice & vbNewLine & _
"Number of Unique Purchase Orders : " & UniquePO, _
vbOKOnly, "Results"
End Sub
Private Sub ResetDB()
Set Rng = Range("A1:" & Range("A65536").End(xlUp).Offset(0,
1).Address)
End Sub
Private Sub ChangeDB()
Dim KntPO As Long
Dim LastRecord As Range
KntPO = WorksheetFunction.CountA(Rng.Columns(2)) - 1
Rng.Columns(2).SpecialCells(xlCellTypeBlanks).Value = False
Set LastRecord = Range("A" & Rng.Rows.Count - KntPO)
Set Rng = Range("A1:" & LastRecord.Offset(0, 1).Address)
End Sub
Private Sub DoSort(sortkey As String, sortorder As Integer)
With Worksheets("Sheet1")
.Range("A1").Sort _
Key1:=.Columns(sortkey), _
Order1:=sortorder, _
Header:=xlGuess
End With
End Sub
Private Sub DoPrimaryKey()
Dim ExanpleRange As Range
Dim FillRange As Range
Columns("C:C").Insert
Range("C1:C3").Value = Application.Transpose(Array("Record", 1,
2))
With Worksheets("Sheet1")
Set ExampleRange = .Range("C2:C3")
Set FillRange = .Range("C2:C" & Rng.Rows.Count)
ExampleRange.AutoFill Destination:=FillRange
End With
End Sub
Private Sub DoFilter()
Rng.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("IT1:IU2"), _
CopyToRange:=Range("IV1"), _
Unique:=True
End Sub
Sub SetResults(Cl As Long)
Range("IT1:IU1").Value = Rng.Range(Cells(1, 1), Cells(1, 2)).Value
Range("IV1").Value = Rng.Cells(1, Cl).Value
End Sub
|
Similar Threads
