Как сделать запись в динамический двумерный массив

Option Base 1
Dim NameArray() As Variant, Iname As String, Add As Boolean
ReDim NameArray(1, 2)
m = 0
                For i = 2 To 10 Step 1
                    Iname = Cells(i, 10).Value
                    Itime = Cells(i, 1).Value
                    If Len(Iname) > 1 Then
                            Add = True
                              For j = 1 To UBound(NameArray)
                                 If NameArray(j, 1) = Iname Then
                                  Add = False
                                End If
                              Next j
                                
                                 If Add Then
                                    m = m + 1
                                    ReDim Preserve NameArray(m, 2)
                                    NameArray(m, 1) = Iname
                                    NameArray(m, 2) = Itime
                                 End If
                    End If
                Next i

Sub t()
  Dim d As Object, i%
  Set d = CreateObject("scripting.dictionary")
  For i = 2 To 10
    If Not d.exists(Cells(i, 10).Value) Then d.Add Cells(i, 10).Value, Cells(i, 1).Value
  Next
  ' чисто для проверки
  [aa2].Resize(d.Count).Value = Application.Transpose(d.keys)
  [ab2].Resize(d.Count).Value = Application.Transpose(d.items)
End Sub

Sub test()
    Dim b(), i&, ii&, x&, t!
 
    For x = 1 To 1000
        t = Timer - t
 
        If x Mod 10 = 0 Then Application.StatusBar = ii & " = " & Application.Round(t, 2)
 
        For i = 1 To 1000
            ii = ii + 1
            ReDim Preserve b(ii)
        Next
 
    Next
 
    Application.StatusBar = False
End Sub