Get unique ID values from one column then concatenate: Error 13, type mismatch

Question

The code is meant to get unique ID values from one column and then on the other column concatenate it's values based on the unique IDs.

phishLR = defendersSht.Cells.Find(what:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
Dim dc As Object
Dim inputArray As Variant
Dim k As Long

tempEIDCN = phishLC + 1
tempCampaignsCN = phishLC + 2
'Copy values onto temp columns to make them side by side (temp solution until I figure out how to do it with separate columns
defendersSht.Range(Cells(1, tempEIDCN).Address, Cells(phishLR, tempEIDCN).Address).Value2 = _
                                                                                          defendersSht.Range(Cells(1, eidPhishCN).Address, Cells(phishLR, eidPhishCN).Address).Value2
defendersSht.Range(Cells(1, tempCampaignsCN).Address, Cells(phishLR, tempCampaignsCN).Address).Value2 = _
                                                                                                      defendersSht.Range(Cells(1, phishAlarmCN).Address, Cells(phishLR, phishAlarmCN).Address).Value2

Set dc = New Dictionary
inputArray = WorksheetFunction.Transpose(defendersSht.Range(ColLett(tempEIDCN) & "2:" & ColLett(tempCampaignsCN) & phishLR).Value)

'Assuming only have two columns - otherwise need two loops
For k = LBound(inputArray, 2) To UBound(inputArray, 2)
    If Not dc.Exists(inputArray(1, k)) Then
        dc.Add inputArray(1, k), inputArray(2, k)
    Else
        dc.Item(inputArray(1, k)) = dc.Item(inputArray(1, k)) & ", " & inputArray(2, k)
    End If
Next k
'Clear values currently in column
defendersSht.Range(Cells(2, eidPhishCN).Address, Cells(phishLR, eidPhishCN).Address).ClearContents
defendersSht.Range(Cells(2, phishAlarmCN).Address, Cells(phishLR, phishAlarmCN).Address).ClearContents

'Output into sheet
defendersSht.Range(ColLett(eidPhishCN) & "2").Resize(UBound(dc.Keys) + 1) = Application.Transpose(dc.Keys)
defendersSht.Range(ColLett(phishAlarmCN) & "2").Resize(UBound(dc.Items) + 1) = Application.Transpose(dc.Items)

'Delete Temp Columns
defendersSht.Columns(tempCampaignsCN).ClearContents
defendersSht.Columns(tempEIDCN).ClearContents

Set dc = Nothing

I get

type mismatch

at:

If Not dc.Exists(inputArray(1, k)) Then

As a bonus, I'm copying the columns to the next available column in order to keep them together as I can't figure out how to do this with the columns not being consecutive.

Answer 1

Option Explicit

Sub Process()

    Const eidPhishCN = 1
    Const phishAlarmCN = 5

    Dim defendersSht As Worksheet, lastrow As Long, r As Long
    Dim dc, v, k As String
    Dim ar1, ar2, t0 As Single: t0 = Timer
    Set dc = CreateObject("Scripting.Dictionary")
    
    Set defendersSht = ThisWorkbook.Sheets("Defenders")
    With defendersSht
        lastrow = .Cells(Rows.Count, eidPhishCN).End(xlUp).Row
        ar1 = .Cells(1, eidPhishCN).Resize(lastrow)
        ar2 = .Cells(1, phishAlarmCN).Resize(lastrow)
        For r = 2 To lastrow
            k = Trim(ar1(r, 1))
            v = Trim(ar2(r, 1))
            If dc.Exists(k) Then
                dc.Item(k) = dc.Item(k) & ", " & v
            Else
                dc.Add k, v
            End If
        Next
        
        ' clear existing
        .Cells(2, eidPhishCN).Resize(lastrow - 1).ClearContents
        .Cells(2, phishAlarmCN).Resize(lastrow - 1).ClearContents
        
        ' save unique values
        .Cells(2, eidPhishCN).Resize(dc.Count) = Application.Transpose(dc.keys)
        .Cells(2, phishAlarmCN).Resize(dc.Count) = Application.Transpose(dc.items)
        
    End With
   
    MsgBox lastrow - 1 & " rows scanned", vbInformation, "Took " & Format(Timer - t0, "0.0 secs")
     
End Sub