COUNTIF() in 'For' loop

Question

I have a column with nearly 100k and am trying to determine how many times a value occurs repeatedly in that column. I can do it row by row currently, but this is menial as a programmer, through something like =COUNTIF(D:D,D2). Yet that only returns D2 matches in column D.

I need to iterate through all values of D returning countif, therefore revealing all of the values repetitions in the column. I can remove duplicates later! So I have a dev. button a basic sub, or function (man this is new to me) and something along the lines of the most basic for loop ever. Just getting caught up on how to implement the COUNTIF() to to the loop properly.

Right now I'm looking at:

Sub doloop()

Dim i As Integer
i = 1

Do While i < D.Length
    Cells(i, 8).Value =CountIf(D:D,D[i])
    i = i + 1
Loop
End Sub

That code is incorrect obviously but it is where I'm at and may help for anyone more familiar with other languages.

Answer 1

Use Application.WorksheetFunction.CountIf() in your loop.

Private Sub doloop()

    Dim lastRow   As Long
    Dim d         As Double
    Dim r         As Range
    Dim WS        As Excel.Worksheet
    Dim strValue  As String
    Dim lRow      As Long

    'Build your worksheet object
    Set WS = ActiveWorkbook.Sheets("sheet1")

    'Get the last used row in column A
    lastRow = WS.Cells(WS.Rows.count, "D").End(xlUp).Row

    'Build your range object to be searched
    Set r = WS.Range("D1:D" & lastRow)

    lRow = 1
    WS.Activate

    'Loop through the rows and do the search
    Do While lRow <= lastRow

        'First, get the value we will search for from the current row
        strValue = WS.Range("D" & lRow).Value

        'Return the count from the CountIf() worksheet function
        d = Application.worksheetFunction.CountIf(r, strValue)

        'Write that value to the current row
        WS.Range("H" & lRow).Value = d

    lRow = lRow + 1
    Loop

End Sub

I believe you are trying to write the value to the cell, that is what the above does. FYI, if you want to put a formula into the cell, here is how that is done. Use this in place of WS.Range("H" & lRow).Value = d

WS.Range("H" & lRow).Formula = "=CountIf(D:D, D" & lRow & ")"

Answer 2

Sounds like you may want to look into using tables in Excel and capitalizing on their features like filtering and equation autofill. You may also be interested in using a PivotTable to do something very similar to what you're describing.

If you really want to go about this the programmatic way, I think the solution Matt gives answers your question about how to do this using CountIf. There's a big detriment to using CountIf though, in that it's not very computationally efficient. I don't think the code Matt posted will really be practical for processing the 100K rows mentioned in the OP (Application.ScreenUpdating = false would help some). Here's an alternative method that's a lot more efficient, but less intuitive, so you'll have to decide what suites your needs and what you feel conformable with.

Sub CountOccurances()
    'Define Input and Output Ranges
    'The best way to do this may very from case to case,
    'So it should be addressed seperately
    'Right now we'll assume current sheet rows 1-100K as OP specifies
    Dim RInput, ROutput As Range
    Set RInput = Range("D1:D100000")
    Set ROutput = Range("E1:E100000")

    'Define array for housing and processing range values
    Dim A() As Variant
    ReDim A(1 To RInput.Rows.Count, 0)
    'Use Value2 as quicker more accurate value
    A = RInput.Value2

    'Create dictionary object
    Set d = CreateObject("Scripting.Dictionary")

    'Loop through array, adding new values and counting values as you go
    For i = 1 To UBound(A)
        If d.Exists(A(i, 1)) Then
            d(A(i, 1)) = d(A(i, 1)) + 1
        Else
            d.Add A(i, 1), 1
        End If
    Next

    'Overwrite original array values with count of that value
    For i = 1 To UBound(A)
        A(i, 1) = d(A(i, 1))
    Next

    'Write resulting array to output range
    ROutput = A
End Sub

You can also modify this to include the removal of replicates you mentioned.

Sub CountOccurances_PrintOnce()
    'Define Input and Output Ranges
    'The best way to do this may very from case to case,
    'So it should be addressed seperately
    'Right now we'll assume current sheet rows 1-100K as OP specifies
    Dim RInput, ROutput As Range
    Set RInput = Range("D1:D100000")
    Set ROutput = Range("F1:F9")

    'Define array for housing and processing range values
    Dim A() As Variant
    ReDim A(1 To RInput.Rows.Count, 0)
    'Use Value2 as quicker more accurate value
    A = RInput.Value2

    'Create dictionary object
    Set d = CreateObject("Scripting.Dictionary")

    'Loop through array, adding new values and counting values as you go
    For i = 1 To UBound(A)
        If d.Exists(A(i, 1)) Then
            d(A(i, 1)) = d(A(i, 1)) + 1
        Else
            d.Add A(i, 1), 1
        End If
    Next


    'Print results to VBA's immediate window
    Dim sum As Double
    For Each K In d.Keys
        Debug.Print K & ": " & d(K)
        sum = sum + d(K)
    Next
    Debug.Print "Total: " & sum

End Sub