Countif using vba arrays

**YasserKhalil** · 05-10-2016, 06:11 PM

Hello everyone
I have the following code that uses COUNTIF but it takes some time to execute ..

Sub Test()
    Dim Ws1 As Worksheet
    
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Application.EnableEvents = False
        With Ws1
            LR = .Cells(Rows.Count, 1).End(xlUp).Row
            With .Range("I3:I" & LR)
                .Formula = "=COUNTIF($A1:$A100000,A3)"
                .Value = .Value
            End With
        End With
    Application.EnableEvents = True
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

Can it be done using vba arrays?
I mean to count the item of the array withing the whole array and get the result stored in an array then to put the results in one shot in cell I3
Hope it is clear

**YasserKhalil** · 05-10-2016, 06:45 PM

I found the following code that has the same idea
But I need to store the results of count occurrences in an array and put this array in range("I3")

Sub aTest()
    Dim myArray() As Variant, Dict As Object
    Dim I As Long, V As Variant

    myArray = Array("Apple", "Orange", "Banana", "Banana", "Apple", "Banana")
    Set Dict = CreateObject("Scripting.Dictionary")

    For I = LBound(myArray) To UBound(myArray)
        If Dict.exists(myArray(I)) Then
            Dict.Item(myArray(I)) = Dict.Item(myArray(I)) + 1
        Else
            Dict.Add myArray(I), 1
        End If
    Next I

    For Each V In Dict.keys
        MsgBox V & " " & Dict.Item(V)
    Next V
End Sub

**jindon** · 05-10-2016, 06:56 PM

Sub test()
    Dim a, i As Long
    With Range("a3", Range("a" & Rows.Count).End(xlUp))
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 1 To UBound(a, 1)
                If a(i, 1) <> "" Then .Item(a(i, 1)) = .Item(a(i, 1)) + 1
            Next
            For i = 1 To UBound(a, 1)
                a(i, 1) = .Item(a(i, 1))
            Next
        End With
        .Columns("i").Value = a
    End With
End Sub

**YasserKhalil** · 05-10-2016, 07:12 PM

What a wonderful and fascinating code
That's exactly what I was searching for
You are incredible Mr. Jindon the Great
Thank you very much.. I am so glad of this perfect solution
Best Regards

**YasserKhalil** · 05-10-2016, 08:02 PM

Mr. Jindon
Can I add a request for this thread?
I need to color the cells in column A related to the count .. if count > 1 then to color the cell
See the attachment
If possible I need different colors for each

**jindon** · 05-10-2016, 08:23 PM

Sub test()
    Dim a, i As Long, temp, rng As Range
    Dim dic As Object, r As Long, g As Long, b As Long
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Range("A3", Range("A" & Rows.Count).End(xlUp))
        a = .Value: Set rng = .Cells
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 1 To UBound(a, 1)
                If a(i, 1) <> "" Then .Item(a(i, 1)) = .Item(a(i, 1)) + 1
            Next i
            For i = 1 To UBound(a, 1)
                temp = a(i, 1)
                If Not dic.exists(temp) Then
                    r = Application.RandBetween(0, 255)
                    g = Application.RandBetween(0, 255)
                    b = Application.RandBetween(0, 255)
                    dic(temp) = RGB(r, g, b)
                End If
                a(i, 1) = .Item(a(i, 1))
                If a(i, 1) > 1 Then rng.Cells(i, 1).Interior.Color = dic(temp)
            Next i
        End With
        .Columns("I").Value = a
    End With
End Sub

**YasserKhalil** · 05-10-2016, 08:40 PM

Thank you very much Mr. Jindon for these wonderful gifts
Last point i promise you .. what if I need just one color for all duplicates .. what should I change in the code to get it?

**jindon** · 05-10-2016, 08:43 PM

Replace dic(temp) with vbYellow/vbRed etc.

**YasserKhalil** · 05-10-2016, 09:20 PM

Thanks a lot for this great help Mr. Jindon
All codes are wonderful in fact
I need to emphasis an important point which is that I need to do the color for cells in one shot ..
I don't need to deal with the cells one by one .. and I think you did it in your codes .. Am I right about this thought?

**YasserKhalil** · 05-10-2016, 08:46 PM

What about these lines

r = Application.RandBetween(0, 255)
                    g = Application.RandBetween(0, 255)
                    b = Application.RandBetween(0, 255)

I think they would be useful in this case .. Am I right?

**jindon** · 05-10-2016, 08:51 PM

What do you want to do?

You can delete all lines that I have added in the 2nd code and just add that few lines.

Sub test()
    Dim a, i As Long, rng As Range
    With Range("a3", Range("a" & Rows.Count).End(xlUp))
        a = .Value: Set rng = .Cells
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 1 To UBound(a, 1)
                If a(i, 1) <> "" Then .Item(a(i, 1)) = .Item(a(i, 1)) + 1
            Next
            For i = 1 To UBound(a, 1)
                a(i, 1) = .Item(a(i, 1))
                If a(i, 1) > 1 Then rng.Cells(i, 1).Interior.Color = vbYellow
            Next
        End With
        .Columns("i").Value = a
    End With
End Sub

Countif using vba arrays

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Countif using vba arrays

Re: Countif using vba arrays

Re: Countif using vba arrays

Re: Countif using vba arrays

Re: Countif using vba arrays

Re: Countif using vba arrays

Re: Countif using vba arrays

Re: Countif using vba arrays

Re: Countif using vba arrays

Re: Countif using vba arrays

Re: Countif using vba arrays

Thread Information

Users Browsing this Thread

Similar Threads

storing multiple value in a single cell (through arrays or without arrays)?

COUNTIF(?) For Multiple Arrays With Multiple Conditions

[SOLVED] Add countIf to textbox (arrays)

Declaring multiple multi-dimensional arrays (jagged arrays) - compile error?

[SOLVED] CountIF VBA Arrays

[SOLVED] New to arrays-where do I find a good beginners guide to multi dimensional arrays

[SOLVED] COUNTIF and arrays?

Bookmarks

Bookmarks

Posting Permissions