Finding no. of time a value occurs with other combination - vba

Question

I have a column containing departments and another column containing Appt, Can, No show. I want to calculate how many time every department has occurred for Appt, Can and No Show. The code I am currently using extracts unique values of department and using If statements counts the value of Appt, Can and No Show.
Data Set:
http://bit.ly/1HkvAxR
Code to get unique departments:
Public Sub Getting_Unique_Departments()
Dim X
Dim objDict As Object
Dim lngRow As Long
If Len("E") > 0 And Len("Y") > 0 Then
Set objDict = CreateObject("Scripting.Dictionary")
X = Application.Transpose(Range("E" & 2, Cells(Rows.Count, "E").End(xlUp)))
For lngRow = 1 To UBound(X, 1)
objDict(X(lngRow)) = 1
Next
Range("Y" & 2 & ":" & "Y" & objDict.Count + 1) = Application.Transpose(objDict.keys)
End If
End Sub
Code to check Appt, Can, walk and No Show for each department.
Sub Calculation()
nName0 = "Department"
nName1 = "Appt"
nName2 = "Walk"
nName3 = "Can"
nName4 = "No Show"
Cells(1, 25).Value = nName0
Cells(1, 26).Value = nName1
Cells(1, 27).Value = nName2
Cells(1, 28).Value = nName3
Cells(1, 29).Value = nName4
For Dept_Row_number = 2 To Dept_lastRow
'Dept_lastRow finds last Row of unique department listed in Y col and Sheet_lastRow finds the last Row of input data sheet.
nCount1 = 0
nCount1 = 0
nCount2 = 0
nCount3 = 0
nCount4 = 0
Row_number = 1
search_string1 = ActiveSheet.Cells(Dept_Row_number, 25)
Do
DoEvents
Row_number = Row_number + 1
item_in_review1 = ActiveSheet.Cells(Row_number, 5).Value
item_in_review2 = ActiveSheet.Cells(Row_number, 3).Value
If InStr(item_in_review1, search_string1) > 0 And InStr(item_in_review2, "Appt") > 0 Then
nCount1 = nCount1 + 1
ElseIf InStr(item_in_review1, search_string1) > 0 And InStr(item_in_review2, "Walk") > 0 Then
nCount2 = nCount2 + 1
ElseIf InStr(item_in_review1, search_string1) > 0 And InStr(item_in_review2, "Can") > 0 Then
nCount3 = nCount3 + 1
ElseIf InStr(item_in_review1, search_string1) > 0 And InStr(item_in_review2, "No Show") > 0 Then
nCount4 = nCount4 + 1
End If
Loop Until Row_number = Sheet_lastRow
Cells(Dept_Row_number, 26).Value = nCount1
Cells(Dept_Row_number, 27).Value = nCount2
Cells(Dept_Row_number, 28).Value = nCount3
Cells(Dept_Row_number, 29).Value = nCount4
Next
Is there any easy way to this because in case I have to do this for more than one column, the code would be too cucumbersome.

Answer 1

Byron Wall is correct that Pivot Tables are a natural choice -- but you can also streamline the VBA. You are aware of dictionaries but could be exploiting them more. I recommend using early binding -- in Tools/References add a reference to Microsoft Scripting Runtime and then you can write code along the following lines. The main loop populates a dictionary keyed to departments. The values of this dictionary are themselves dictionaries keyed by your categories ("No Show", etc.). The values of those dictionaries are the counts that you are after. At the end of the code I show how you can extract data from this data structure:
Function MakeCountDict(categories As Variant) As Dictionary
Dim d As New Dictionary
Dim i As Long
For i = LBound(categories) To UBound(categories)
d.Add categories(i), 0
Next i
Set MakeCountDict = d
End Function
Sub MakeDepartmentCounts()
Dim Dcounts As New Dictionary
Dim R As Range
Dim dept As Variant, cat As String
Dim categories As Variant
Dim i As Long, n As Long
Dim report As String
categories = Array("No Show", "Appt", "Can", "walk")
n = Range("H:H").Rows.Count
n = Range("H" & n).End(xlUp).Row 'last used row in column H
For i = 2 To n
dept = Trim(Cells(i, "H").Value)
If Not Dcounts.Exists(dept) Then
Dcounts.Add dept, MakeCountDict(categories)
End If
cat = Trim(Cells(i, "C").Value)
Dcounts(dept)(cat) = Dcounts(dept)(cat) + 1
Next i
report = "Report:"
For Each dept In Dcounts.Keys
report = report & vbCrLf & dept & ": "
For i = 0 To 3
cat = categories(i)
report = report & cat & " = " & Dcounts(dept)(cat) & IIf(i < 3, ", ", "")
Next i
Next dept
MsgBox report
End Sub
To test it I created random data in columns C and H that had the format of your linked picture then ran it. My output:
Department 5: No Show = 1, Appt = 1, Can = 1, walk = 2
Department 3: No Show = 5, Appt = 2, Can = 1, walk = 2
Department 4: No Show = 2, Appt = 1, Can = 0, walk = 1
Department 2: No Show = 2, Appt = 1, Can = 2, walk = 1
Department 1: No Show = 1, Appt = 1, Can = 0, walk = 2
This shows that the order of keys when you iterate is a bit random -- but you could do something like have a for j = 1 to 5 loop rather than a for each dept in keys loop.