CountIF within an Array VBA

Question

This should be easy and I think I am almost there. I would like to count how many times an entry repeats itself within a certain array. The array will be populated from a range. Eventually if the number of the count is more than 4, I would like to insert "Excess", otherwise if less than 4, I would like to insert "Insufficient", else is "complete". Unfortunately, even though I have learnt to do these calculations without using Arrays, I find some difficulties when switching to Arrays.

How the code should look like

Sub test()
    Dim MyArray() As Variant, Countarrays() As Variant, Result() As Variant
    Dim r As Range
    Dim rows As Integer

    Worksheets("Sheet1").Activate
    Set r = Range("B2", Range("B1").End(xlDown))
    MyArray = Range("B2", Range("B1").End(xlDown))
    rows = Range("B2", Range("B1").End(xlDown)).Count

    For i = 0 To rows
        For j = 0 To rows
        Countarrays(i, 1) = WorksheetFunction.CountIf(r, MyArray(i))

        If (Countarrays(i, 1).value) > 4 Then Result(j, 1) = "Excess"
        ElseIf (Countarrays(i, 1).value) < 4 Then Result(j, 1) = "Insufficient"
        ElseIf (Countarrays(i, 1).value) = 4 Then Result(j, 1) = "Complete"
        Next j
    Next i

End Sub

You can't directly use COUNTIF or whatever Excel function as such on a 2 dimensional array, populating an array from a range creates a 2 dimensional array. So you need a workaround. — Damian
– Damian, Commented May 15, 2019 at 11:16
repeats itself within a row or a column? Or within entire array? — QHarr
– QHarr, Commented May 15, 2019 at 11:20
What about using a dictionary? You could add each unique item to your dictionary, and then increases the value everytime the item repeats. After that, loop trough your dictionary, If value of item <4 then Insufficient elseif >4 then Excess Else Complete. You can even know how many is the Excess (2,3,4...units) and same for Insufficient. About Dictionaries in VBA, check Excel VBA Dictionary – A Complete Guide — Foxfire And Burns And Burns
– Foxfire And Burns And Burns, Commented May 15, 2019 at 11:29

Damian · Accepted Answer · 2019-05-15 11:37:18Z

1

This should do the trick:

Option Explicit
Sub Test()

    Dim MyArray, DictDuplicates As New Scripting.Dictionary, i As Long

    With ThisWorkbook.Sheets("Sheet1") 'change if needed
        MyArray = .Range(.Cells(2, 1), .Cells(2, 2).End(xlDown))
        For i = LBound(MyArray) To UBound(MyArray) 'loop to store all the items and how many times do they repeat
            If Not DictDuplicates.Exists(MyArray(i, 2)) Then 'if doesn't exists will store it
                DictDuplicates.Add MyArray(i, 2), 1
            Else 'if it does exists will increment its item value
                DictDuplicates(MyArray(i, 2)) = DictDuplicates(MyArray(i, 2)) + 1
            End If
        Next i

        For i = LBound(MyArray) To UBound(MyArray) 'loop to give back the result
            Select Case DictDuplicates(MyArray(i, 2))
                Case Is > 4
                    MyArray(i, 1) = "Excess"
                Case Is = 4
                    MyArray(i, 1) = "Complete"
                Case Is < 4
                    MyArray(i, 1) = "Insufficient"
            End Select
        Next i
        .Range(.Cells(2, 1), .Cells(2, 2).End(xlDown)) = MyArray
    End With

End Sub

Note that for the DictDuplicates to work, you need to check the Microsoft Scripting Runtime library.

edited May 15, 2019 at 11:37

answered May 15, 2019 at 11:30

Damian

5,1741 gold badge12 silver badges22 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Alessio_110 Over a year ago

Although it works as a charm, could you please explain me also how to use late binding in preventing to check the Microsoft Scripting Runtime all the times?

Damian Over a year ago

@Alessio_110 here you can find anything on dictionaries, is really helpful.

Collectives™ on Stack Overflow

CountIF within an Array VBA

1 Answer 1

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related