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,345
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,082,333
Messages
5,364,675
Members
400,810
Latest member
elbashka

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top