VBA Dic Key with multiple Items in differnt columns

[Stephen_IV]

Is there another way to approch this. I am trying to count multiple items in different columns with one key. right now I am using,

dic.Add cell.Value, cell.Value & "|" & WorksheetFunction.CountIfs(Range("A:A"), cell.Value, Range("B:B"), "<>") & "|" & WorksheetFunction.CountIfs(Range("A:A"), cell.Value, Range("C:C"), "<>")

Any help would be great! Thanks.

VBA Dic Mult Items in Columns.xlsm A B C D E F G H I J 1 School Students Parents ID Student Parent 2 111 A 111 6 3 3 111 B 222 4 0 4 111 C 333 2 1 5 111 D A 444 2 2 6 111 E 555 3 1 7 222 F 8 222 G 9 222 H 10 333 I 11 333 J 12 444 K 13 444 L 14 444 A 15 111 W 16 111 Q 17 222 G 18 333 U 19 444 Y 20 555 M 21 555 M 22 555 X 23 555 C 24 111 V Sheet2 Option Explicit Sub Countit() Dim dic As New Dictionary Dim k As Variant Dim cell As Range Dim lastrow As Long Dim i As Long lastrow = Cells(Rows.Count, "A").End(xlUp).Row For Each cell In Range("A2:A" & lastrow) If Not dic.Exists(cell.Value) Then dic.Add cell.Value, cell.Value & "|" & WorksheetFunction.CountIfs(Range("A:A"), cell.Value, Range("B:B"), "<>") & "|" & WorksheetFunction.CountIfs(Range("A:A"), cell.Value, Range("C:C"), "<>") End If Next Range("H1").Value = "ID" Range("I1").Value = "Student" Range("J1").Value = "Parent" i = 2 For Each k In dic.Items Cells(i, "H").Resize(, 3).Value = Split(k, "|") i = i + 1 Next k End Sub

 

[Fluff]

How about

Sub Countit()
Dim dic As New Dictionary
Dim k As Variant, tmp As Variant
Dim cell As Range
Dim lastrow As Long
Dim i As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For Each cell In Range("A2:A" & lastrow)
        If Not dic.Exists(cell.Value) Then
            dic.Add cell.Value, Array(-(cell.Offset(, 1) <> ""), -(cell.Offset(, 2) <> ""))
         Else
            tmp = dic(cell.Value)
            tmp(0) = tmp(0) - (cell.Offset(, 1) <> "")
            tmp(1) = tmp(1) - (cell.Offset(, 2) <> "")
            dic(cell.Value) = tmp
        End If
    Next
Range("H1").Value = "ID"
Range("I1").Value = "Student"
Range("J1").Value = "Parent"
Range("H2").Resize(dic.Count).Value = Application.Transpose(dic.Keys)
Range("I2").Resize(dic.Count, 2).Value = Application.Index(dic.Items, 0, 0)
End Sub

 

[Stephen_IV]

Thanks Fluff. That is right on!! I appreciate all of your help and admire your posts! Thanks again!

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Kyle123]

You could also use a pivot table as an alternative, you wouldn't need VBA then