VBA Working with Dictionary

[anthonyexcel]

I am working with dictionaries and am very new to them. I have a small sample below. What I am trying to do is to have a unique list with the number of times SICK occurs. I am able to accomplish this but then I would also like to bring back the first and last name which I am having a problem with. I want

ID	Count	First	Last
10878	5	George	Washington

<tbody>
</tbody>

But I get this

ID	Count
10878	5

<tbody>
</tbody>

This is the sample data set
<style type="text/css">
table.tableizer-table {
font-size: 12px;
border: 1px solid #CCC;
font-family: Arial, Helvetica, sans-serif;
}
.tableizer-table td {
padding: 4px;
margin: 3px;
border: 1px solid #CCC;
}
.tableizer-table th {
background-color: #104E8B;
color: #FFF;
font-weight: bold;
}
</style>

Emp#	FirstName	LastName	Accrual Description
10878	George	Washington	VACATION
10878	George	Washington	VACATION
10878	George	Washington	VACATION
10878	George	Washington	VACATION
10878	George	Washington	VACATION
10878	George	Washington	VACATION
10878	George	Washington	VACATION
10878	George	Washington	VACATION
10878	George	Washington	VACATION
10878	George	Washington	VACATION
10878	George	Washington	VACATION
10878	George	Washington	VACATION
10878	George	Washington	SICK
10878	George	Washington	SICK
10878	George	Washington	SICK
10878	George	Washington	SICK
10878	George	Washington	SICK
10878	George	Washington	PERSONAL
10878	George	Washington	PERSONAL
10878	George	Washington	PERSONAL
10878	George	Washington	PERSONAL
10878	George	Washington	PERSONAL
11768	AL	Gore	VACATION
11768	AL	Gore	VACATION
11768	AL	Gore	SICK
11768	AL	Gore	SICK
11768	AL	Gore	SICK
11768	AL	Gore	SICK
11768	AL	Gore	SICK
11768	AL	Gore	SICK
11768	AL	Gore	PERSONAL
11768	AL	Gore	PERSONAL
11768	AL	Gore	PERSONAL
11768	AL	Gore	PERSONAL

<tbody>
</tbody>

Sub Countit()
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim dic As New Dictionary
    For Each cell In Range("A2:A" & lastrow)
        If cell.Offset(0, 3) = "SICK" Then
            If Not dic.Exists(cell.Value) Then
                dic.Add cell.Value, WorksheetFunction.CountA(cell.Value)
                Else
                dic.Item(cell.Value) = dic.Item(cell.Value) + WorksheetFunction.CountA(cell.Value)
            End If
        End If
    Next
    Range("P1") = "ID"
    Range("Q1") = "Count"
    Range("Q2").Resize(dic.Count, 1).Value = WorksheetFunction.Transpose(dic.Items)
    Range("P2").Resize(dic.Count, 1).Value = WorksheetFunction.Transpose(dic.Keys)
End Sub

Thanks in advance

 

[L. Howard]

With formulas?

Howard

Excel 2012
	P	Q	R	S
1	ID	Count	First	Last
2	11768	6	AL	Gore
Sheet1

Cell Formulas
Range	Formula
Q2	=SUMPRODUCT(($A$2:$A$35=P2)*($D$2:$D$35="SICK"))
R2	=VLOOKUP(P2,A2:B35,2,0)
S2	=VLOOKUP(P2,A2:C35,3,0)

 

[anthonyexcel]

Thanks L. Howard for the reply but I am really trying to learn the VBA end, so if anyone else has any input I would appreciate it.

 

[L. Howard]

Maybe something like this. Where you have a drop down in cell O2 with the Accrual Description's and a drop down in P2 with all the ID Numbers.

Copy this to the sheet module.

Then select a Description and an employee ID number and results are in cells Q2, R2, S2.

Howard

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("$P$2")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

Dim lastRow As Long
Dim AccDec As String

lastRow = Cells(Rows.Count, "A").End(xlUp).Row
AccDec = Cells(2, 15)

  With Range("Q2")
    .Formula = "=SUMPRODUCT(($A$2:$A" & lastRow & "=P2)*($D$2:$D" & lastRow & "=O2))": .Value = .Value
  End With
  
    With Range("R2")
    .Formula = "=VLOOKUP(P2,A2:B" & lastRow & ",2,0)": .Value = .Value
  End With
  
    With Range("S2")
    .Formula = "=VLOOKUP(P2,A2:C" & lastRow & ",3,0)": .Value = .Value
  End With
End Sub

Excel 2012
	O	P	Q	R	S
1	Acc Desc.	ID	Count	First	Last
2	VACATION	11768	4	AL	Gore
Sheet1

 

[Domenic]

There are other ways of achieving the same results using the Dictionary object. But here I've amended your existing macro. You'll notice that I've added the Option Explicit statement, which goes at the top of the module. This forces you to declare all variables, which is a good practice, and it will help pinpoint any existing errors.

Option Explicit

Sub Countit()
    Dim dic As New Dictionary
    Dim vItem As Variant
    Dim cell As Range
    Dim lastrow As Long
    Dim nextrow As Long
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For Each cell In Range("A2:A" & lastrow)
        If cell.Offset(0, 3) = "SICK" Then
            If Not dic.Exists(cell.Value) Then
                dic.Add cell.Value, cell.Value & "|" & WorksheetFunction.CountIfs(Range("A:A"), cell.Value, Range("D:D"), "SICK") & "|" & cell.Offset(, 1).Value & "|" & cell.Offset(, 2).Value
            End If
        End If
    Next
    Range("P1").Value = "ID"
    Range("Q1").Value = "Count"
    Range("R1").Value = "First"
    Range("S1").Value = "Last"
    nextrow = 2
    For Each vItem In dic.Items
        Cells(nextrow, "P").Resize(, 4).Value = Split(vItem, "|")
        nextrow = nextrow + 1
    Next vItem
End Sub

Hope this helps!

 

[anthonyexcel]

Thanks Domenic I really appreciate you replying to my post! I appreciate all of your help and guidance! Thanks again!