Count Unique Values

RobJr · Mar 11th 2016

Hello,
I have tried for the better part of 2 days to find some code for counting unique values in a range and so far nothing has worked. I suspect it has more to do with the code I have to identify the range containing the values than the coding that I found.

The brief explanation as to why I have this code to find the ranges is that we have reports generated daily that were designed poorly up front but we (the end users) have no control for having them improved.

The end result of the following code is to identify the range for the count for each worksheet (this portion working). So rng4 will result in something like $E$34:$E$406.

What I am looking for is code that can reference "rng4" and count the unique values therein. The results of that count will then be placed in cell B1.

I would appreciate any help/advice that I can get on this.

Thanks

Code

Sub RenameTabsV2()
Dim Wb As Workbook
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Variant
Dim rng5 As Range
Dim LastRow As Long
Set Wb = ActiveWorkbook
'Rename each sheet in workbook
For Each ws In ActiveWorkbook.Worksheets
    Set rng1 = ws.Range("A:A").Find("Group Number")
        If Not rng1 Is Nothing Then
    ws.Name = rng1.Offset(1, 0).Value
End If
'Identify if the data to count is in column E or C then identify the starting and stopping cells for the count
On Error Resume Next
If ws.CodeName = "Sheet1" Then
    Set rng2 = ws.Range("E:E").Find("Employee SSN", lookat:=xlPart)
        LastRow = ws.UsedRange.Rows.Count + ws.UsedRange.Rows(1).Row - 1
    Set rng3 = ws.Range("E" & LastRow)
rng4 = rng2.Offset(1, 0).Address & ":" & rng3.Address
Else
Set rng2 = ws.Range("C5")
    LastRow = ws.UsedRange.Rows.Count + ws.UsedRange.Rows(1).Row - 1
        Set rng3 = ws.Range("C" & LastRow)
    rng4 = rng2.Address & ":" & rng3.Address
End If
ws.Range("A1") = rng4 'Temp value to use for testing/verifying the range on each sheet.  To be replaced once the unique counts coding is functional.
'Range("A1") = "EE Count:"
Range("B1") = Application.WorksheetFunction.SumProduct((rng4 <> "") / Application.WorksheetFunction.CountIf(rng4, rng4))
Next ws
End Sub

Display More

shknbk2 · Mar 12th 2016

Re: Count Unique Values

Try this. The function creates an AdvancedFilter copy of just the unique values of rng4 in an out of the way place (the right-most column of the worksheet), counts the values, and then clears the data before returning the number back to Range("A1").

Code

Sub RenameTabsV2()
    Dim Wb As Workbook
    Dim ws As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim rng4 As Variant
    Dim rng5 As Range
    Dim LastRow As Long
    Set Wb = ActiveWorkbook
    'Rename each sheet in workbook
    For Each ws In ActiveWorkbook.Worksheets
        Set rng1 = ws.Range("A:A").Find("Group Number")
            If Not rng1 Is Nothing Then
                ws.Name = rng1.Offset(1, 0).Value
            End If
        'Identify if the data to count is in column E or C then identify the starting and stopping cells for the count
        On Error Resume Next
        If ws.CodeName = "Sheet1" Then
            Set rng2 = ws.Range("E:E").Find("Employee SSN", lookat:=xlPart)
            LastRow = ws.UsedRange.Rows.Count + ws.UsedRange.Rows(1).Row - 1
            Set rng3 = ws.Range("E" & LastRow)
            rng4 = rng2.Offset(1, 0).Address & ":" & rng3.Address
        Else
            Set rng2 = ws.Range("C5")
            LastRow = ws.UsedRange.Rows.Count + ws.UsedRange.Rows(1).Row - 1
            Set rng3 = ws.Range("C" & LastRow)
            rng4 = rng2.Address & ":" & rng3.Address
        End If
        ws.Range("A1") = countUniques(rng4) 'Temp value to use for testing/verifying the range on each sheet.  To be replaced once the unique counts coding is functional.
        'Range("A1") = "EE Count:"
        Range("B1") = Application.WorksheetFunction.SumProduct((rng4 <> "") / Application.WorksheetFunction.CountIf(rng4, rng4))
    Next ws
End Sub


Function countUniques(filterRange As Range) As Integer
    Dim filterCell As Range
    
    Set filterCell = Cells(1, Columns.Count)
    filterRange.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=filterCell, Unique:=True
    countUniques = filterCell.CurrentRegion.Rows.Count
    Columns(filterCell.Column).Delete
    Set filterCell = Nothing
End Function

Display More

The only change I made in your sub was

Code

ws.Range("A1") = countUniques(rng4)

RobJr · Mar 14th 2016

Re: Count Unique Values

Thanks shknbk2, this code looks promising but unfortunately does not work as intended. That being said, I don't think the problem is in your code I think it is in mine. Specifically as it pertains to rng4. I don't think it is correctly translating as a range. Through DIM I set it as variant because the other options I tried just popped errors. Your code as you have it gave a type mismatch error on rng4 so I added .Address to it and that seems to have resolved that issue and that is the only change I made. I reworked the error handler so that it should only handle 1 specific error to see if any others would pop but no luck. I added debug.print but all I got was 5 lines containing only a single space each. At this point I am not getting any errors but I am not getting any results either.

Any other advice?

Thanks

shknbk2 · Mar 14th 2016

Re: Count Unique Values

Try this to make it a range:

Code

Sub RenameTabsV2()
    Dim Wb As Workbook
    Dim ws As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim rng4 As Range
    Dim rng5 As Range
    Dim LastRow As Long
    Set Wb = ActiveWorkbook
     'Rename each sheet in workbook
    For Each ws In ActiveWorkbook.Worksheets
        Set rng1 = ws.Range("A:A").Find("Group Number")
        If Not rng1 Is Nothing Then
            ws.Name = rng1.Offset(1, 0).Value
        End If
         'Identify if the data to count is in column E or C then identify the starting and stopping cells for the count
        On Error Resume Next
        If ws.CodeName = "Sheet1" Then
            Set rng2 = ws.Range("E:E").Find("Employee SSN", lookat:=xlPart)
            LastRow = ws.UsedRange.Rows.Count + ws.UsedRange.Rows(1).Row - 1
            Set rng3 = ws.Range("E" & LastRow)
            Set rng4 = ws.Range(rng2.Offset(1, 0), rng3)
        Else
            Set rng2 = ws.Range("C5")
            LastRow = ws.UsedRange.Rows.Count + ws.UsedRange.Rows(1).Row - 1
            Set rng3 = ws.Range("C" & LastRow)
            Set rng4 = ws.Range(rng2, rng3)
        End If
        ws.Range("A1") = countUniques(rng4) 'Temp value to use for testing/verifying the range on each sheet.  To be replaced once the unique counts coding is functional.
         'Range("A1") = "EE Count:"
        Range("B1") = Application.WorksheetFunction.SumProduct((rng4 <> "") / Application.WorksheetFunction.CountIf(rng4, rng4))
    Next ws
End Sub
 
Function countUniques(filterRange As Range) As Integer
    Dim filterCell As Range
     
    Set filterCell = Cells(1, Columns.Count)
    filterRange.AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=filterCell, Unique:=True
    countUniques = filterCell.CurrentRegion.Rows.Count
    Columns(filterCell.Column).Delete
    Set filterCell = Nothing
End Function

Display More

RobJr · Mar 14th 2016

Re: Count Unique Values

That is how I first tried it and the results are that rng4 = nothing. If I modify the code to be "Set rng4 =" then I get a type mismatch error on the second & portion of " Set rng4 = rng2.Offset(1, 0).Address & ":" & rng3.Address " and if I modify that it just cascades into 1 error after another. Since starting this reply I have tried a few more things including multiple different DIM options but I have come full circle, "Variant" is the only one that actually allows rng4 to get a value. And the value is correct; just seemingly not usable.

Thanks

RobJr · Mar 14th 2016

Re: Count Unique Values

Hello, Please disregard my last post. I missed a couple of the changes you made. Once I had it all in it worked like a charm. I can't thank you enough.

shknbk2 · Mar 14th 2016

Re: Count Unique Values

You're welcome. Glad it's working.

Count Unique Values

Participate now!

Share