Neu Dimensionierung schlägt fehl

Option Explicit
Public Function doku(ByVal c As Range, _
ByRef name As String, _
ByRef rows As Long, _
ByRef col As Long) As Boolean
Dim n As String
doku = False
n = ""
While doku = False
If Left(c.Value, 4) = "Spur" Then 'Wenn Zelle den String "Spur" hat
n = c.Value
rows = c.Row    'Benötigt für Range in Sub daten()
col = c.Column  'Benötigt für Range in Sub daten()
name = n
doku = True
End If
Exit Function   'Um Dauerschleife zu verhindern
Wend
End Function
Sub daten()
Dim ws, ws_2 As Worksheet
Dim rng, r As Range
Dim x As Long, y As Long
Dim i As Integer, j As Integer
Dim fnc As Boolean
Dim sname As String
Dim l As Long
Dim b, d, xmax
Dim arr_a(), arr_b() As Double
l = 0: xmax = 0
i = 1: j = 1: b = -1: d = -1
Set ws = ThisWorkbook.Sheets("Übersicht")
With ws
Do While xmax  "" Then 'mache solange bis Zelle in Spalte "Nr." Leer ist
If r.Offset(, 1).Value  "" Then   'Hole erst Daten wenn Zelle  _
daneben nicht leer ist
b = b + 1   'um auf Null zukommen
d = d + 1   ' ""
ReDim Preserve arr_a(xmax, b) 'Neu Dimensionierung
ReDim Preserve arr_b(xmax, d) 'Hierbei tritt Fehler auf, wenn  _
xmax > 0 ist
arr_a(xmax, b) = r.Offset(, 1).Value    'array mit Daten Füllen
arr_b(xmax, d) = Round(r.Offset(, 2).Value, 2) '""
'Debug.Print arr_a(xmax, b)
'Debug.Print arr_b(xmax, d)
End If
End If
Next r
End If
d = -1
b = -1
j = j + 9
xmax = xmax + 1
Loop
End With
End Sub