Macro Error, can't locate problem

New Here and I need some help.

I had a friend create a program and it has worked perfectly for a while. Now I am having issues with it and can't get in contact with him. The program looks a values in Column A, and if find finds the value in Column B and combines them into a cell with a delimiter of ";" (semicolon). I have a set of data that it will not do this for, it keeps giving me a Runtime Error '13', type mismatch.


As I said this is over my head, here is the code that he created. The line in bold is where the debug says the issue is. I have searched and searched and can't find the problem.

_____________________________________________________________________________________

Sub CombineAndConcatenate()


Application.ScreenUpdating = False


'***WORKS ASSUMING DATA THAT IS TO BE COMBINED / CONCATENATED IS IN COLUMNS A & B***


'declare variables
Dim dc As Object
Dim inputArray As Variant
Dim i As Integer
Dim x As Long

'find last row of reference column
x = Range("A" & Rows.Count).End(xlUp).row

'set / define data to use
Set dc = CreateObject("Scripting.Dictionary")
inputArray = WorksheetFunction.Transpose(Range("A2:B" & x).Value)


'run through data and combine
For i = LBound(inputArray, 2) To UBound(inputArray, 2)
If Not dc.Exists(inputArray(1, i)) Then
dc.Add inputArray(1, i), inputArray(2, i)
Else
dc.Item(inputArray(1, i)) = dc.Item(inputArray(1, i)) & "," & inputArray(2, i)
End If
Next i


'output to sheet
Range("C2").Resize(UBound(dc.keys) + 1) = Application.Transpose(dc.keys)
Range("D2").Resize(UBound(dc.items) + 1) = Application.Transpose(dc.items)


Set dc = Nothing


Application.ScreenUpdating = True


End Sub

_____________________________________________________________________________________

Attached is the list I am working with.


Please any help is appreciated.