Keep or store rows for each non-repeated name

[KingTamo]

Hello excel experts

In the first worksheet, there are values from range("A2:F" & lr) where lr is the last row based on column A. In column D, there are names (the names are repeated). I need to build a dictionary for the unique names (column D) which will be keyed. Each key should store a 2d array of the rows related to that key.

I found that code but I got errors on this line [ReDim Preserve rows(LBound(rows) To UBound(rows) + 1, 1 To 6)]

Sub BuildDictionary()

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim lr As Long
    lr = ws.Cells(ws.rows.Count, "A").End(xlUp).Row
    
    Dim data As Variant
    data = ws.Range("A2:F" & lr).Value
    
    Dim i As Long
    For i = 1 To UBound(data)
        Dim key As String
        key = data(i, 4)
        If Not dict.Exists(key) Then
            dict.Add key, Array()
        End If
        Dim rows As Variant
        rows = dict(key)
        ReDim Preserve rows(LBound(rows) To UBound(rows) + 1, 1 To 6)
        rows(UBound(rows), 1) = data(i, 1)
        rows(UBound(rows), 2) = data(i, 2)
        rows(UBound(rows), 3) = data(i, 3)
        rows(UBound(rows), 4) = data(i, 4)
        rows(UBound(rows), 5) = data(i, 5)
        rows(UBound(rows), 6) = data(i, 6)
        dict(key) = rows
    Next i

End Sub