Excel VBA dictionary- How to get get Item values of Duplicate Key in cells? - excel

Question

Im trying to find way how to use Dictionary to delete duplicate values and concatenate items values in cells.
Code belowe is doing what i imagine but I can see it in immediate window (Debug.Print dict(People).
Item (ID) of duplicate values of dictionary Keys(People) are concatenate with comma but i dont know how to extract that Items to cell.
So idea for VBA to do is find duplicate value and concatenate ID values and delete duplicate.
Thank you!
Option Explicit
Sub DictionaryTest()
Dim dict As Scripting.Dictionary
Dim rowCount As Long
Dim People As String
Dim ID As Integer
Dim item As Variant
Set dict = New Scripting.Dictionary
rowCount = Cells(Rows.Count, "E").End(xlUp).Row
'Debug.Print rowCount
Do While rowCount > 1
People = Sheet2.Cells(rowCount, "E").Value
ID = Sheet2.Cells(rowCount, "D").Value
If dict.Exists(People) Then
'Sheet2.Rows(rowCount).EntireRow.Delete
Else
dict.Add People, ID
End If
rowCount = rowCount - 1
Loop
End Sub

Answer 1

Try this adapted code, please:
Sub DictionaryTest()
Dim dict As New Scripting.Dictionary
Dim rowCount As Long, i As Long
Dim People As String
Dim ID As Integer
Dim sh As Worksheet
Set sh = Sheet2
rowCount = sh.cells(Rows.count, "D").End(xlUp).Row
For i = 2 To rowCount
People = sh.cells(i, "D").Value
ID = sh.cells(i, "C").Value
If dict.Exists(People) Then
dict(People) = dict(People) & "," & ID
Else
dict.Add People, ID
End If
Next i
sh.Range("F2").Resize(dict.count).Value = WorksheetFunction.Transpose(dict.Items)
sh.Range("G2").Resize(dict.count).Value = WorksheetFunction.Transpose(dict.Keys)
End Sub