Breaking up a large Excel procedure - excel

Question

I have two procedures that both run out of memory due to my data set in Excel exceeding a very vast amount.
Sub format()
Dim x, Y(), i&, j&, k&, s
x = Range("A1", Cells(1, Columns.count).End(xlToLeft)).Value
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 1 To UBound(x, 2)
.Item(x(1, i)) = i
Next i
x = Application.Trim(Range("BL3", Cells(Rows.count, "BL").End(xlUp)).Value)
ReDim Y(1 To UBound(x), 1 To .count): j = 1
For i = 1 To UBound(x)
If InStr(x(i, 1), "==") = 0 Then
s = Split(x(i, 1))
If .Exists(s(0)) Then
k = .Item(s(0)): Y(j, k) = mid(x(i, 1), Len(s(0)) + 2)
End If
Else
j = j + 1
End If
Next i
End With
[a2].Resize(j, UBound(Y, 2)).Value = Y()
End Sub
Above is the procedure I've been using to split/trim a column of data into several rows/columns.
Ive put data into two columns, each consisting of 60k rows each, what I need to do is once its read through BL, read through BO and continue where it left off putting the second row of data underneath the new row from whereever the first one finished

Answer 1

Something like this (UNTESTED) might work for you. It avoids creating a huge 2D array by using smaller-size blocks.
Sub format()
Const BLOCK_SIZE As Long = 10000
Dim x, Y(), i&, j&, k&, s
Dim d As Object
Dim rOffset As Long
Dim xCount As Long
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = 1
x = Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Value
For i = 1 To UBound(x, 2)
'using Add: you probably want this to error if duplicates exist...
d.Add x(1, i), i
Next i
x = Application.Trim(Range("BL3", Cells(Rows.Count, "BL").End(xlUp)).Value)
xCount = UBound(x)
rOffset = 0
ReDim Y(1 To BLOCK_SIZE, 1 To d.Count)
j = 1
For i = 1 To xCount
If InStr(x(i, 1), "==") = 0 Then
s = Split(x(i, 1))
If d.Exists(s(0)) Then
k = d(s(0))
Y(j, k) = Mid(x(i, 1), Len(s(0)) + 2)
End If
Else
j = j + 1
If j > BLOCK_SIZE Then
[a2].Offset(rOffset, 0).Resize(BLOCK_SIZE, d.Count).Value = Y()
ReDim Y(1 To BLOCK_SIZE, 1 To d.Count)
j = 1
rOffset = rOffset + BLOCK_SIZE
End If
End If
Next i
[a2].Offset(rOffset, 0).Resize(BLOCK_SIZE, d.Count).Value = Y()
End Sub