Text To Columns Macro (to avoid out of memory error)

dougf

New Member
Joined
Mar 15, 2009
Messages
28
I am trying to convert cells (all in column D) which are separated by "~" into columns. Unfortunately, running the text to columns command on several rows at a time can cause Excel to panic with an out of memory error (error #7 etc.).

The file is ~100mb and contains 500k-700k rows (I have 4GB of RAM so I know this is more a limit of Excel's 2GB RAM constraint).

Can you please help me write a macro to text to column convert each cell in column D?

I tried a macro which started with a for loop, and called the function for each cell individually, but even this led to an out of memory exception after 156,000 rows (although the same macro worked fine on a similar sheet with 700,000 rows).

Are there any other ways of clearing the Excel buffer/temporary space during the function calls to avoid causing Excel to crash?

Thanks!
 

PCL

Well-known Member
Joined
Jul 15, 2008
Messages
1,347
Try next code.
It assumes there is enought columns free after column D
Code:
Sub Split_Data()
Dim LASTROW As Long
Dim I As Long, J As Long
Dim LLength As Long
Dim MySTRING As String
Dim MyCHAR As String
Dim MyRG As Range
Dim F As String
Dim NbPART As String
Dim POS  As Long
Dim A
    Application.ScreenUpdating = False       '   WITHOUT  REFRESH SCREEN
    MyCHAR = "~"
    LASTROW = Range("D" & Rows.Count).End(xlUp).Row
    For I = 1 To LASTROW
        F = Cells(I, "D")
        NbPART = Len(F) - Len(Replace(F, MyCHAR, "")) + 1
        For J = 1 To NbPART - 1
            POS = InStr(F, MyCHAR)
            Cells(I, "D").Offset(0, J) = Left(F, POS - 1)
            F = Right(F, Len(F) - POS)
        Next J
        Cells(I, "D").Offset(0, J) = Right(F, Len(F) - 1)
    Next I
    Application.ScreenUpdating = True       '   WITH  REFRESH SCREEN
End Sub
 
L

Legacy 14611

Guest
Code:
Sub txt_to_col()
Dim n As Long, I As Long, J As Long, c(), A, y
n = Cells(Rows.Count, "d").End(xlUp).Row
ReDim c(1 To n, 1 To 1)
A = Range("D1:D" & n)
For I = 1 To n
    y = Split(Cells(I, "d"), "~", -1)
If UBound(y) > s Then s = UBound(y)
If s > UBound(c, 2) - 1 Then ReDim Preserve c(1 To n, 1 To s + 1)
For J = 0 To UBound(y)
    On Error Resume Next
    c(I, J + 1) = y(J)
    On Error GoTo 0
Next J, I
Range("F1").Resize(n, UBound(c, 2)) = c
End Sub
 
L

Legacy 14611

Guest
or, if you want it to run faster
Code:
Sub txt_to_col()
Dim n As Long, i As Long, j As Long, c(), a, y
n = Cells(Rows.Count, "d").End(xlUp).Row
ReDim c(1 To n, 1 To 1)
a = Range("D1:D" & n)
For i = 1 To n
    y = Split(a(i,1), "~", -1)
If UBound(y) > s Then s = UBound(y)
If s > UBound(c, 2) - 1 Then ReDim Preserve c(1 To n, 1 To s + 1)
For j = 0 To UBound(y)
    On Error Resume Next
    c(i, j + 1) = y(j)
    On Error GoTo 0
Next j, i
Erase a
Range("F1").Resize(n, UBound(c, 2)) = c
End Sub
 

dougf

New Member
Joined
Mar 15, 2009
Messages
28
or, if you want it to run faster
Code:
Sub txt_to_col()
Dim n As Long, i As Long, j As Long, c(), a, y
n = Cells(Rows.Count, "d").End(xlUp).Row
ReDim c(1 To n, 1 To 1)
a = Range("D1:D" & n)
For i = 1 To n
    y = Split(a(i,1), "~", -1)
If UBound(y) > s Then s = UBound(y)
If s > UBound(c, 2) - 1 Then ReDim Preserve c(1 To n, 1 To s + 1)
For j = 0 To UBound(y)
    On Error Resume Next
    c(i, j + 1) = y(j)
    On Error GoTo 0
Next j, i
Erase a
Range("F1").Resize(n, UBound(c, 2)) = c
End Sub
Hi Rugila,

Unfortunately this code immediately leads to an Out Of Memory #7 exception. The debugger highlights "ReDim Preserve c(1 To n, 1 To s + 1)"

Are there any alternatives?


PCL, the line "Cells(I, "D").Offset(0, J) = Right(F, Len(F) - 1)" is an invalid procedure call.


Thanks!!
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,651
Are there filled columns to the right of column D?
 

phxsportz

Well-known Member
Joined
Jun 11, 2006
Messages
1,985
Hmm... You have 700,000 rows of data ?

I thought Excel had a row limitation of 65,536 rows ?? Could this be the problem ?>
 

Forum statistics

Threads
1,084,878
Messages
5,380,415
Members
401,673
Latest member
Ali Balleya

Some videos you may like

This Week's Hot Topics

Top