VBA - Find how many times a cell is present in a column and then print the cell and its count

Question

The idea hear is that a column contains 80,000 rows filled with values, and I want to create a VBA macro which will read every value and count how many times is present in the column and print it, but the problem is that when the loop reaches the same number again, I do not want to print it again because it's already printed.

This is what I wrote so far but I can not get it to work.

Option Explicit

Sub timesofattack()
    Dim count As Long
    Dim count2 As Long
    Dim d As Long
    Dim f As Long
    Dim a As Long

    Do Until IsEmpty(Cells(d, 2).Value)
        f = d

        Do Until IsEmpty(Cells(f, 2).Value)

            If Cells(d, 2).Value = Cells(f, 2).Value Then

                count = count + 1

            End If
            f = f + 1

        Loop

        If count = 1 Then

            f = 8

            Do Until IsEmpty(Cells(f, 2).Value)

                If Cells(d, 2).Value = Cells(f, 2).Value Then

                    count2 = count2 + 1

                End If

                f = f + 1
            Loop

            Range("H8").Offset(a, 0).Value = Cells(d, 2).Value
            Range("G8").Offset(a, 0).Value = count2

            a = a + 1
        End If

        d = d + 1

    Loop

End Sub

To simplify and not use VBA, could you first run the built in function to determine unique values among the 80,000 values, and then do a `=countif()` for each one of the uniques? The sum of the `=countif()` functions should equal 80,000. — Adam Smith, Jun 21 '18 at 02:26
Welcome to StackOverflow. Please edit the question text so that all code is indented with 4 spaces. Looks like you missed a few lines, i.e. everything from `Option Explicit` after and up to / including `End Sub`. — Richie Thomas, Jun 21 '18 at 02:29

score 2 · Accepted Answer · answered Jun 21 '18 at 02:27

Scripting.Dictionary are ideally suited for retrieving unique values and counting duplicates.

Sub timesofattack2()
    Dim data As Variant, key As Variant, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("Data")
        data = .Range("B2", .Range("B" & .Rows.count).End(xlUp)).Value
    End With

    For Each key In data
        dic(key) = dic(key) + 1
    Next

    With ThisWorkbook.Worksheets.Add
        .Range("A2").Resize(dic.count).Value = Application.Transpose(dic.Keys())
        .Range("B2").Resize(dic.count).Value = Application.Transpose(dic.Items())
    End With

End Sub

score 0 · Answer 2 · answered Jun 21 '18 at 02:35

Another option to write the count next to the first occurrence of each item in the list:

Sub timesofattack3()

Set P1 = Range("B1", Range("B999999").End(xlUp))
T1 = P1
Set D1 = CreateObject("scripting.dictionary")
Set D2 = CreateObject("scripting.dictionary")

For i = 1 To UBound(T1)
    If Not D1.exists(T1(i, 1)) Then
        D1.Add T1(i, 1), 1
        D2.Add T1(i, 1), i
    Else
        D1(T1(i, 1)) = D1(T1(i, 1)) + 1
    End If
Next i

For Each k In D2.keys
    Cells(D2(k), 3) = D1(k)
Next

End Sub

VBA - Find how many times a cell is present in a column and then print the cell and its count

2 Answers2