walter while
walter while

Reputation: 107

Using Dictionary (hashing) in VBA

Example from code:

In Cell, AE43, the count is updated only when the sheet "TT" meets the criteria mentioned.

So, similarly I'll have to use the same kind of code 30+ times for different cells to get the data.

So instead of typing the code for similar search, I want to know whether we can use "Dictionary" function (hashing in other languages) here, so that a cell can be updated automatically if it meets the criteria.

Sub WBR()
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction

With ActiveWorkbook.Worksheets("TT")                'no of tickets processed - summary
[AE43] = wf.CountIfs(.Range("I:I"), "<>Duplicate TT", _
                  .Range("G:G"), "<>Not Tested", _
                  .Range("U:U"), "Item")
 End With

With ActiveWorkbook.Worksheets("TT")                'not tested tickets - summary
[AE44] = wf.CountIfs(.Range("G:G"), "Not Tested")
End With

With ActiveWorkbook.Worksheets("TT")                'Tickets moved back- outdated OS and App Versions - summary
[AE45] = wf.CountIf(.Range("I:I"), "Outdated App Version") + wf.CountIf(.Range("I:I"), "Outdated OS")
End With

Upvotes: 0

Views: 164

Answers (1)

Tim Williams
Tim Williams

Reputation: 166401

Here's a basic example which should get you started.

Sub showing how to call the code:

Sub Tester()

    With ThisWorkbook.Sheets("Main")
        .Range("A1") = GetCount("TT", False, "A:A", "Blue")
        .Range("A2") = GetCount("TT", False, "A:A", "Blue", "C:C", "Red")
        .Range("A3") = GetCount("TT", True, "A:A", "Blue", "C:C", "Red")
    End With


End Sub

Generalized version of your use cases:

'If addValues is True and there are >1 set of criteria then 
'   sum up a bunch of COUNTIF(), else use COUNTIFS() so all 
'   criteria are applied at the same time
Function GetCount(shtName As String, addValues As Boolean, _
                                           ParamArray crit()) As Long

    Dim sht As Worksheet, f As String, num As Long, i As Long
    Set sht = ThisWorkbook.Sheets(shtName)'<< counting things on this sheet
    num = UBound(crit)

    If num = 1 Or addValues Then
        f = "COUNTIF(" & crit(0) & ",""" & crit(1) & """)"
    End If

    If num > 1 Then
        If addValues Then
            'already got the first pair: add the rest
            For i = 2 To num Step 2
                f = f & " + COUNTIF(" & crit(i) & ",""" & crit(i + 1) & """)"
            Next i
        Else
            f = "COUNTIFS("
            For i = 0 To num Step 2
                f = f & crit(i) & ",""" & crit(i + 1) & """"
                If i <> num - 1 Then f = f & ","
            Next i
            f = f & ")"
        End If
    End If

    If f <> "" Then
        Debug.Print f
        GetCount = sht.Evaluate(f) '<<do not use Application.Evaluate here
    Else
        GetCount = -1 '<< something went wrong...
    End If

End Function

Debug output:

COUNTIF(A:A,"Blue")
COUNTIFS(A:A,"Blue",C:C,"Red")
COUNTIF(A:A,"Blue") + COUNTIF(C:C,"Red")

Probably could use some error-handling and if there are other use cases you'll need to add those in.

Upvotes: 2

Related Questions