Copy and paste values into one cell - excel

Question

I want to create a VBA code where it could copy all the unique file owner emails into one cell and all the file locations into the cell next to it, being separated by a comma. Is that possible? I created a code to grab the unique values and pasted into cell L1 and create a table, and this is what I have so far:
This is an example of what Excel would look like
This is an example what I want the VBA code to do
Public Sub unique_emails()
Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("L1" _
), Unique:=True
Range("L1").Select
Dim tbl As ListObject
Dim rng As Range
Set rng = Range(Range("L1"), Range("L1").SpecialCells(xlLastCell))
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
tbl.TableStyle = "TableStyleMedium16"
End Sub

Answer 1

Unique Delimited (Dictionary)
Adjust the values in the constants section.
Option Explicit
Public Sub unique_emails()
Const sFirst As String = "A1"
Const dFirst As String = "L1"
Const Delimiter As String = ", "
' Worksheet
Dim ws As Worksheet: Set ws = ActiveSheet
' Source Range
Dim rg As Range
With ws.Range(sFirst).Resize(, 2)
Dim lCell As Range
Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , xlByRows, xlPrevious)
If lCell Is Nothing Then Exit Sub
Set rg = .Resize(lCell.Row - .Row + 1)
End With
Dim rCount As Long: rCount = rg.Rows.Count
' Source Range to Array
Dim Data As Variant: Data = rg.Value
Dim n As Long
If rCount > 1 Then
' Array to Dictionary
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Variant
For n = 2 To rCount
Key = Data(n, 2)
If Not IsError(Key) Then
If Len(Key) > 0 Then
If dict.Exists(Key) Then
dict(Key) = dict(Key) & Delimiter & Data(n, 1)
Else
dict(Key) = Data(n, 1)
End If
End If
End If
Next n
' Dictionary to Array
n = 1
For Each Key In dict.Keys
n = n + 1
Data(n, 1) = Key
Data(n, 2) = dict(Key)
Next Key
Else
n = 1
End If
' Switch Headers
Key = Data(1, 1): Data(1, 1) = Data(1, 2): Data(1, 2) = Key
' Array to Destination Range
With ws.Range(dFirst).Resize(, 2)
.Resize(n).Value = Data
.Resize(.Worksheet.Rows.Count - .Row - n + 1).Offset(n).ClearContents
End With
End Sub