Count Unique

[fb7894]

Can I use a formula to:

Count the unique deal-ids where a salesperson is in any field.

For the sample data below, I'm looking for the following results:
Joe = 2
Tim = 3

Joe is on two unique Deal Ids (100 & 200). Tim = 3 unique deal ids (100,200,300)



Deal ID
SalesPerson1
SalesPerson2
SalesPerson3
SalesPerson4


100
Joe

Joe



100
Joe
Joe
Tim



200
Tim
Joe

Joe


300
Tim

[mperrah]

I'm sure there is a more efficient way of doing this task, but my way works for the data you have supplied.
If we can build a better loop to fill the matching DealID across to accomodate more ID's then we'll have a winner.


Sub vbax53631()
Dim lr, lc, lrG, lrH, i, r, c, x, sp As Long
Dim DealID, sp_list As Variant

lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column

Range("A2:A" & lr).Copy Destination:=Range("G1") ' Deal ID list
ActiveSheet.Range("$G$1:$G" & lr).RemoveDuplicates Columns:=1, Header:=xlNo

x = 0
For r = 2 To lr
For c = 2 To lc

If Cells(r, c).Value <> "" Then
x = x + 1
Cells(x, 8).Value = Cells(r, c).Value
End If
Next c
Next r

lrH = Cells(Rows.Count, 8).End(xlUp).Row ' Salesperson List
ActiveSheet.Range("$H$1:$H" & lrH).RemoveDuplicates Columns:=1, Header:=xlNo

lrG = Cells(Rows.Count, 7).End(xlUp).Row
ReDim DealID(1 To lrG)
For x = 1 To lrG
DealID(x) = Cells(x, 7).Value
Next x

lrH = Cells(Rows.Count, 8).End(xlUp).Row
ReDim sp_list(1 To lrH)
For x = 1 To lrH
sp_list(x) = Cells(x, 8).Value
Next x

For sp = LBound(sp_list) To UBound(sp_list)
For r = 2 To lr
For c = 2 To lc
If Cells(r, c) = sp_list(sp) Then ' this part needs help for unlimited DealID's - this only handles 3
If Cells(sp, 9).Value = "" Then
Cells(sp, 9).Value = Cells(r, 1).Value
Else
If Cells(sp, 9).Value = Cells(r, 1) Then
Else
If Cells(sp, 10).Value = "" Then
Cells(sp, 10).Value = Cells(r, 1).Value
Else
If Cells(sp, 10).Value = Cells(r, 1) Then
Else
If Cells(sp, 11).Value = "" Then
Cells(sp, 11).Value = Cells(r, 1).Value
Else
If Cells(sp, 11).Value = Cells(r, 1).Value Then
End If
End If
End If
End If
End If
End If
End If
Next c
Next r
Next sp

Range("G1").FormulaR1C1 = "=COUNT(RC[2]:RC[8])"
Range("G1").AutoFill Destination:=Range("G1:G3"), Type:=xlFillDefault

End Sub

[snb]

Sub M_snb()
sn=sheet1.cells(1).currentregion.resize(,5)

with createobject("scripting.dictionary")
for j=2 to ubound(sn)
for jj=2 to ubound(sn,2)
if sn(j,jj)<>"" then x0=.item(sn(jj,1) & sn(j,jj))
next
next
msgbox ubound(filter(.items,"Joe"))
msgbox ubound(filter(.items,"Tim"))
end with
End Sub

More on dictionaries:
http://www.snb-vba.eu/VBA_Dictionary_en.html

[mperrah]

This is a little cleaner (not like snb)
It now accounts for multiple salespersons and multiple DealID's
We can put the output on a different sheet or farther to right if you have more salepersons.


Sub vbax53631()
Dim lr, lc, lrG, lrH, i, r, c, x, sp As Long
Dim DealID, sp_list As Variant

Range("G1:O50").ClearContents

lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column

Range("A2:A" & lr).Copy Destination:=Range("G1") ' Deal ID list
ActiveSheet.Range("$G$1:$G" & lr).RemoveDuplicates Columns:=1, Header:=xlNo

x = 0
For r = 2 To lr
For c = 2 To lc

If Cells(r, c).Value <> "" Then
x = x + 1
Cells(x, 8).Value = Cells(r, c).Value
End If
Next c
Next r

lrH = Cells(Rows.Count, 8).End(xlUp).Row ' Salesperson List
ActiveSheet.Range("$H$1:$H" & lrH).RemoveDuplicates Columns:=1, Header:=xlNo

lrG = Cells(Rows.Count, 7).End(xlUp).Row
ReDim DealID(1 To lrG)
For x = 1 To lrG
DealID(x) = Cells(x, 7).Value
Next x

lrH = Cells(Rows.Count, 8).End(xlUp).Row
ReDim sp_list(1 To lrH)
For x = 1 To lrH
sp_list(x) = Cells(x, 8).Value
Next x


For r = 2 To lr
For c = 2 To lc
For sp = LBound(sp_list) To UBound(sp_list)
If Cells(r, c) = sp_list(sp) Then
For dID = LBound(DealID) To UBound(DealID)
If Cells(r, 1).Value = DealID(dID) Then
x = dID
End If
Next dID
Cells(sp, 8 + x).Value = Cells(r, 1)
End If
Next sp
Next c
Next r


Range("G1").FormulaR1C1 = "=COUNT(RC[2]:RC[8])"
Range("G1").AutoFill Destination:=Range("G1:G" & lrH), Type:=xlFillDefault