Excel VBA scripting dictionary keys not working

Question

I have the following data

Code    Num     ID   Date      FID
FSL        400  1   1/1/2013    a
FSL        -45  2   1/1/2013    c
DFL        22   1   1/1/2013    b
DFL       300   1   6/1/2012    a
FSL       -30   2   6/1/2012    c
SCL        21   3   6/1/2012    b
DFL       10    1   1/5/2012    a
DFL       20    2   1/5/2012    c
SCL       200   3   1/5/2012    b

That I would like to reshape to look like this: For each ID, I would like to track Code and Num across dates. So my rows will be ID and my columns will be Date_Num and Date_Code

This is my macro:

Sub widen()

Dim arrayDateAll As Variant, arrayDateUnique As Variant, arrayIDAll As Variant, arrayIDUnique As Variant, arrayVarDate As Variant

Dim Name1 As String, Name2 As String


'I store the Date and ID data arrays         

arrayDateAll = WorksheetFunction.Transpose(Worksheets("Sheet3").Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)).Value)
arrayIDAll = WorksheetFunction.Transpose(Worksheets("Sheet3").Range(Cells(2, 3), Cells(Rows.Count, 3).End(xlUp)).Value)




Name1 = Range("A1").Value
Name2 = Range("B1").Value

'I use scripting dictionaries to extract unique dates and unique IDs    

Dim dc As Object, dcID As Object

Set dc = CreateObject("Scripting.Dictionary")
Set dcID = CreateObject("Scripting.Dictionary")


For i = LBound(arrayDateAll) To UBound(arrayDateAll)
   If Not dc.Exists(arrayDateAll(i)) Then
      dc.Add arrayDateAll(i), i
   End If
      If Not dcID.Exists(arrayIDAll(i)) Then
      dcID.Add arrayIDAll(i), i
   End If
Next i










'I transfer the unique dates and IDs to arrays

arrayDateUnique = dc.Keys()
arrayIDUnique = dcID.Keys()




ReDim arrayVarDate(1 To 2 * (UBound(arrayDateUnique) + 1))

' I create Date_Code and Date_Num variables

For i = 1 To UBound(arrayVarDate)

    If i < 4 Then
       arrayVarDate(i) = CStr(arrayDateUnique(i - 1)) & "_" & Name1
       Else
       arrayVarDate(i) = CStr(arrayDateUnique(i - 1 - 3)) & "_" & Name2
    End If
Next i


    Set WS = Worksheets.Add
With WS

 'create row and column headers for the (about to be ) widened data in a new sheet

.Name = "Wide4"

 Range(.Cells(2, 1), .Cells(UBound(arrayIDUnique) + 1 + 1, 1)) = arrayIDUnique

 Range(.Cells(1, 2), .Cells(1, UBound(arrayVarDate) + 1 + 1)) = arrayVarDate



End With

ActiveWorkbook.Save



For Each v In dcID.Keys
        Debug.Print "ID: " & v & " number: "; dcID.Item(v)

    Next

For i = LBound(arrayIDUnique) To UBound(arrayIDUnique)
     Debug.Print arrayIDUnique(i)
Next i
Set dc = Nothing

End Sub

This is the result of my macro:

I am getting my IDs to be all 1. Even though when I debug.print both dcID.Keys and also arrayIDUnique I get the right IDs namely:

ID: 1 number:  1 
ID: 2 number:  2 
ID: 3 number:  6 
 1 
 2 
 3 

Also, I am geeting a #NA as a column and I am no sure why that's happening.

Answer 1

1) Try to change

ReDim arrayVarDate(1 To 2 * (UBound(arrayDateUnique) + 1))

to

ReDim arrayVarDate(1 To 2 * (UBound(arrayDateUnique))) it should fix "#N/A" issue

2) Try to use

Range(.Cells(2, 1), .Cells(UBound(arrayIDUnique) + 1 + 1, 1)) = WorksheetFunction.Transpose(arrayIDUnique)

instead

Range(.Cells(2, 1), .Cells(UBound(arrayIDUnique) + 1 + 1, 1)) = arrayIDUnique - it should fix issue with id