Excel VBA Subroutine: Counting unique number of entries in a column

[HockeyGuy4433]

Hi everyone,

I'm trying to count the unique number of entries in column A (A2:A16050) in my worksheet titled "RawData". The sheet contains info on the number of accidents involving vehicles, so sometimes an accident can have 2-6 vehicles involved meaning the accident ID will occur repeatedly in column A. The answer will appear in my worksheet titled "Questions" in C5.

Simply put, I'm trying to count the number of occurrences involving more than a single vehicle.

Here is the closest I've come:

Sub CountUnique()

' Number of occurrences involving more than a single vehicle
' Variable declarations

Dim d As Object
Dim c As Variant
Dim i As Long
Dim LastRow As Long
Dim j, count, num, flag, OccNo As String

' Range & clear answer cell

LastRow = Worksheets("RawData").Cells(Rows.count, "A").End(xlUp).Row

Worksheets("Questions").Range("C5").Clear

' Start of code written to count occurrences involving more than a single vehicle

' loop

count = 1

Set d = CreateObject("Scripting.Dictionary")
c = Range("A2:A" & LastRow)
For i = 2 To UBound(c, 1)
d(c(i, 1)) = 1
Next i
Range("B2").Resize(d.count) = Application.Transpose(d.keys)

' Location of answer

Worksheets("Questions").Cells(5, "C") = count

End Sub

 

[Fluff]

Hi & welcome to the board.
how about

Sub CountUnique()
   Dim ary As Variant
   Dim i As Long, j As Long
   
   With Sheets("RawData")
      ary = .Range("A2", .Range("A" & Rows.count).End(xlUp))
   End With
   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(ary)
         If Not .exists(ary(i, 1)) Then .Add ary(i, 1), Nothing Else j = j + 1
      Next i
   End With
   Sheets("Questions").Range("C5").Value = j
End Sub

 

[HockeyGuy4433]

Fluff,

Thanks for the reply.

I'm getting an error reading:Run-time error '429':


ActiveX component can't create object

 

[Fluff]

Did you get that error with your code?

 

[HockeyGuy4433]

Yeah when I run the macro that's what pops up. I'm running Excel 2016 on MacOS Sierra 10.12.6.

Is there an alternative way to do it without the create object function? I'm new to coding so I'm trying new things and want to learn as much as possible.

 

[Fluff]

You cannot use a Dictionary on a Mac.
As i don't have a Mac & not all VBA runs on that system, I cannot offer any further help.

 

[Marcelo Branco]

You can achieve this with an array formula
=SUM(IF(FREQUENCY(IF(RawData!A2:A2000<>"",MATCH(RawData!A2:A2000,RawData!A2:A2000,0)),ROW(RawData!A2:A2000)-ROW(RawData!A2)+1)>1,1))

In Excel-Windows you should confirm this formula with Ctrl+Shift+Enter simultaneously.
I have no experience with Mac - take a look at
https://exceljet.net/keyboard-shortcuts/enter-array-formula

M.

 

[HockeyGuy4433]

Marcelo,

Thanks for the help and input. Unfortunately, it has to be a subroutine for this specific task.

 

[Marcelo Branco]

Marcelo,

Thanks for the help and input. Unfortunately, it has to be a subroutine for this specific task.

See if this works in MAC - worked for me (Excel 2010 - Windows)

Sub UniqueGreater1()
     Dim rData As Range
     
     With Sheets("RawData")
        Set rData = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
     End With
    
    Sheets("Questions").Range("C5").Value = _
         Evaluate(Replace("=SUM(IF(FREQUENCY(IF(RawData!@<>"""",MATCH(RawData!@,RawData!@,0))," _
          & "ROW(RawData!@)-ROW(RawData!A2)+1)>1,1))", "@", rData.Address))
End Sub

M.

 

[Marcelo Branco]

The code above counts only duplicate entries (unique).
If you do want to count unique irrespective of duplicates or not, try

Sub Unique()
     Dim rData As Range
     
     With Sheets("RawData")
        Set rData = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
     End With
    
    Sheets("Questions").Range("C5").Value = _
         Evaluate(Replace("=SUM(IF(FREQUENCY(IF(RawData!@<>"""",MATCH(RawData!@,RawData!@,0))," _
          & "ROW(RawData!@)-ROW(RawData!A2)+1),1))", "@", rData.Address))
End Sub

M.