counting unique values seperate by a comma

junkforhr

Board Regular
Joined
Dec 16, 2009
Messages
115
Office Version
  1. 365
Platform
  1. Windows
I have a spreadsheet which has in one column a list of offices in Column H. In Column K there is a lst of locations. In these cells the 'location' has a value of for example ( abcdb 1234), however in a cell there may be more than one value eg (abcd 1234, xxxxx 3241,). I need a macro or formula to count the number of locations per office and also a macro or formula to count the number of unique locations per office and the number of unique locations overall. A small example of the spreadsheet. This spreadsheet can have thousands of rows.Any help/guidance is greatly appreciated.

<table style="border-collapse: collapse; width: 225pt;" border="0" cellpadding="0" cellspacing="0" width="301"><col style="width: 80pt;" width="107"> <col style="width: 145pt;" width="194"> <tbody><tr style="height: 14.4pt;" height="19"> <td class="xl65" style="height: 14.4pt; width: 80pt;" height="19" width="107">Column H</td> <td class="xl64" style="width: 145pt;" width="194">Column K</td> </tr> <tr style="height: 14.4pt;" height="19"> <td class="xl65" style="height: 14.4pt;" height="19">Office 1</td> <td class="xl64">abcs 1234</td> </tr> <tr style="height: 14.4pt;" height="19"> <td class="xl66" style="height: 14.4pt; width: 80pt;" height="19" width="107">office 2</td> <td class="xl64">locationa 2435, locationb 6521</td> </tr> <tr style="height: 14.4pt;" height="19"> <td class="xl65" style="height: 14.4pt;" height="19">Office 3</td> <td class="xl64">abcs 1234</td> </tr> <tr style="height: 14.4pt;" height="19"> <td class="xl66" style="height: 14.4pt; width: 80pt;" height="19" width="107">Office 4</td> <td class="xl64">locationa 2435, locationb 6522</td> </tr> <tr style="height: 14.4pt;" height="19"> <td class="xl65" style="height: 14.4pt;" height="19">Office 5</td> <td class="xl64">abcs 1236</td> </tr> <tr style="height: 14.4pt;" height="19"> <td class="xl65" style="height: 14.4pt;" height="19">Office 1</td> <td class="xl64">locationa 2435, locationb 6522</td></tr></tbody></table>
 
here is a solution for counting unique locations overall,


Code:
Function cntunq(ByVal rng As Range)
Dim cl As Range, i As Integer
Dim dic1, ar
ar = Split(Join(Application.Transpose(Range("B2:B7")), ","), ",")

Set dic1 = CreateObject("Scripting.Dictionary")
dic1.CompareMode = vbTextCompare
For i = 0 To UBound(ar)
    dic1(ar(i)) = ""
Next i
cntunq = dic1.Count
 
End Function

place this code in a standard module (Alt + F11 -> Insert -> Module)
and use the function in the worksheet as below
Excel Workbook
ABCD
1Column HColumn KCount
2Office 1abcs 12345
3Office 2locationa 2435, locationb 6521
4Office 3abcs 1234
5Office 4locationa 2435, locationb 6522
6Office 5abcs 1236
7Office 1locationa 2435, locationb 6522
Sheet1
Cell Formulas
RangeFormula
D2=cntunq(B2:B7)


could you post the expected results for the other question (location per office)?
 
Upvote 0
Thanks sanrv1f

The expected results
Office 1 Unique count should be 3
Office 2 Unique count should be 2
Office 3 Unique count should be 1
Office 4 Unique count should be 2
Office 5 Unique count should be 1

The data for the office has now changed format also, the name of the office will now be as per below. Sorry but this has just been changed and advised to me yesterday. I've also added in some extra locations in the example below than in my previous post.

Excel Workbook
ABCD
1Column HColumn KCount
2Office 1@810@NTabcs 1234,abcs 24355
3Office 2@810@NTlocationa 2435, locationb 6521
4Office 3@810@NTabcs 1234,abcs 1234
5Office 4@4444@QLDlocationa 2435, locationb 6522
6Office 5@222@NSWabcs 1236
7Office 1@810@NTlocationa 2435, locationb 6522
Sheet1
 
Last edited:
Upvote 0
Hi,

I think Sankar is offline now.

try this

Book1
ABCDEFG
1Column HColumn KUnique count per officeNormal count per officeUnique count overallNormal count overall
2Office 1@810@NTabcs 1234,abcs 2435Office 1@810@NT34611
3Office 2@810@NTlocationa 2435, locationb 6521
4Office 3@810@NTabcs 1234,abcs 1234
5Office 4@4444@QLDlocationa 2435, locationb 6522
6Office 5@222@NSWabcs 1236
7Office 1@810@NTabcs 2435, locationb 6522
Sheet1



Code:
Function UNIQUECOUNTIF(ByRef SR As Range, _
                        ByRef RR As Range, _
                        Optional ByVal Crit As Variant, _
                        Optional NCOUNT As Boolean = False) As Long
Dim K1, K2, i As Long, c As Long, x, n As Long
K1 = SR: K2 = RR
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(K1, 1)
        If Not IsMissing(Crit) Then
            If LCase$(K1(i, 1)) = LCase$(Crit) Then
                x = Split(LCase$(K2(i, 1)), ",")
                For c = 0 To UBound(x)
                    If Not .exists(x(c)) Then
                        .Add x(c), 1
                    ElseIf NCOUNT Then
                        .Item(x(c)) = .Item(x(c)) + 1
                    End If
                Next
            End If
        Else
            x = Split(LCase$(K2(i, 1)), ",")
            For c = 0 To UBound(x)
                If Not .exists(x(c)) Then
                    .Add x(c), 1
                ElseIf NCOUNT Then
                    .Item(x(c)) = .Item(x(c)) + 1
                End If
            Next
        End If
    Next
    If .Count > 0 Then UNIQUECOUNTIF = Application.Sum(.items)
End With
End Function

Formulas:

In D2:

=UNIQUECOUNTIF(A2:A7,B2:B7,C2)

E2:

=UNIQUECOUNTIF(A2:A7,B2:B7,C2,TRUE)

F2:

=UNIQUECOUNTIF(A2:A7,B2:B7)

G2:

=UNIQUECOUNTIF(A2:A7,B2:B7,,1)

HTH

@Sankar Congratulations on becoming MrE MVP :beerchug:
 
Upvote 0
thanks Kris worked perfectly!

Sorry to be a pain, but is there also a way to use this function or one like it to get the same counts by postcodes ( this is a new requirement ). The post code is the 3 or 4 digit number in the locations field.
 
Upvote 0
Hi,

Thanks for the feedback.

I added a fifth parameter in the function. Set 5th parmaeter to TRUE to count postcodes.

Code:
Function UNIQUECOUNTIF(ByRef SR As Range, _
                        ByRef RR As Range, _
                        Optional ByVal Crit As Variant, _
                        Optional NCOUNT As Boolean = False, _
                        Optional POSTCODE As Boolean = False) As Long
Dim K1, K2, i As Long, c As Long, x, n As Long
K1 = SR: K2 = RR
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(K1, 1)
        If Not IsMissing(Crit) Then
            If LCase$(K1(i, 1)) = LCase$(Crit) Then
                If POSTCODE Then
                    x = Split(Replace(LCase$(K2(i, 1)), ",", " "), " ")
                Else
                    x = Split(LCase$(K2(i, 1)), ",")
                End If
                For c = 0 To UBound(x)
                    If POSTCODE Then
                        If IsNumeric(x(c)) Then
                            If Not .exists(x(c)) Then
                                .Add x(c), 1
                            ElseIf NCOUNT Then
                                .Item(x(c)) = .Item(x(c)) + 1
                            End If
                        End If
                    Else
                        If Not .exists(x(c)) Then
                            .Add x(c), 1
                        ElseIf NCOUNT Then
                            .Item(x(c)) = .Item(x(c)) + 1
                        End If
                    End If
                Next
            End If
        Else
            If POSTCODE Then
                x = Split(Replace(LCase$(K2(i, 1)), ",", " "), " ")
            Else
                x = Split(LCase$(K2(i, 1)), ",")
            End If
            For c = 0 To UBound(x)
                If POSTCODE Then
                    If IsNumeric(x(c)) Then
                        If Not .exists(x(c)) Then
                            .Add x(c), 1
                        ElseIf NCOUNT Then
                            .Item(x(c)) = .Item(x(c)) + 1
                        End If
                    End If
                Else
                    If Not .exists(x(c)) Then
                        .Add x(c), 1
                    ElseIf NCOUNT Then
                        .Item(x(c)) = .Item(x(c)) + 1
                    End If
                End If
            Next
        End If
    Next
    If .Count > 0 Then UNIQUECOUNTIF = Application.Sum(.items)
End With
End Function

HTH
 
Upvote 0
thanks again Kris, your help is greatly appreciated. Please forgive me for what may seem like a silly question, but can you please post the formulas to give me the results like you did in your initial response, sorry but I am fairly new to all things excel. Once again thanks.
 
Upvote 0
Hi,

Try

In D2:

=UNIQUECOUNTIF(A2:A7,B2:B7,C2,,1)

E2:

=UNIQUECOUNTIF(A2:A7,B2:B7,C2,1,1)

F2:

=UNIQUECOUNTIF(A2:A7,B2:B7,,,1)

G2:

=UNIQUECOUNTIF(A2:A7,B2:B7,,1,1)

HTH
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top