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

dougf · Jul 4, 2009

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!

dougf · Jul 5, 2009

As one other option, and this would be very helpful regardless (I should have thought to include this in the original request), if a new cell starts off with a period and not any letter, can we please tell Excel to place a US in front of the starting period for that cell?

This should also solve the "treat cell contents as a number/decimal" problem.

eg. a cell with ".1234567" or ".D123456" should be replaced with "US.1234567" and "US.D123456" respectively.

Legacy 14611 · Jul 6, 2009

Doug,

Try this one and see how it handles your issues
(a) memory
(b) speed. You can change the stp in about 4th line to 2, 58, 10000 or whatever gives you the best balance between speed and memory non-error.
(c) overwrite original column D
(d) US in front of period

Code:

Sub txt_to_colxxx()
t = Timer
Dim n As Long, i As Long, j As Long, c(), a, y
Dim stp As Long, q As Long, s
stp = 50
n = Cells(Rows.Count, "d").End(xlUp).Row
For q = 1 To (Fix(n / stp) + 1) * stp Step stp
ReDim c(1 To stp, 1 To 1)
a = Range("D" & q).Resize(stp, 1)
For i = 1 To stp
If Not IsEmpty(a(i, 1)) Then
    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 stp, 1 To s + 1)
    For j = 0 To UBound(y)
        If Left(y(j), 1) = "." Then y(j) = "US" & y(j)
        c(i, j + 1) = y(j)
    Next j
End If
Next i
Range("D" & q).Resize(stp, UBound(c, 2)) = c
Next q
MsgBox Format(Timer - t, "0.000")
End Sub

dougf · Jul 6, 2009

rugila said:
Doug,

Try this one and see how it handles your issues
(a) memory
(b) speed. You can change the stp in about 4th line to 2, 58, 10000 or whatever gives you the best balance between speed and memory non-error.
(c) overwrite original column D
(d) US in front of period

Code:

Sub txt_to_colxxx() t = Timer Dim n As Long, i As Long, j As Long, c(), a, y Dim stp As Long, q As Long, s stp = 50 n = Cells(Rows.Count, "d").End(xlUp).Row For q = 1 To (Fix(n / stp) + 1) * stp Step stp ReDim c(1 To stp, 1 To 1) a = Range("D" & q).Resize(stp, 1) For i = 1 To stp If Not IsEmpty(a(i, 1)) Then 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 stp, 1 To s + 1) For j = 0 To UBound(y) If Left(y(j), 1) = "." Then y(j) = "US" & y(j) c(i, j + 1) = y(j) Next j End If Next i Range("D" & q).Resize(stp, UBound(c, 2)) = c Next q MsgBox Format(Timer - t, "0.000") End Sub

Rugila,

For some reason, it seems no matter the size of the step the macro crashes around the 216,000th row (after 3 minutes). I tried it first at 50, and then at 20 (it made it additional 1,000 rows the second time).

The interesting part is that I also ran this macro for a test on a different data set, and the amount of time it took to process 773,000 rows was much more similar to your clocked times (11 seconds).

Legacy 14611 · Jul 6, 2009

Doug,

My Excel 2003 only has 65536 rows and 256 columns, so I'm not able to directly replicate for further testing the type of data that seems to be causing you trouble.

It's interesting that the code works OK with one of your data sets but not with another. I can't speculate much on the reason without seeing the details of those datasets and also not having an Excel version that can test datasets of that size

If the codes by Peter (Vog) and myself to deal with the problem (one cell/row at a time) work OK (but slowly) then the memory problem may lie in the memory-based arrays (a and c) which I used to to try to speed up the process. These can be avoided at the cost of speed by using worksheet cells instead of the memory-based array values.

In the meantime,do you have sufficient material to adequately do your original text-to-columns problem? If the last code I gave can do around 200,000 rows reasonably quickly, maybe you run the job 3-4 times. It's easy to modify the code for this if you like. Otherwise use either of the slower cell-based codes. These are actually essentially the same, except that Peter included application pointers which should make results a bit faster.

GTO · Jul 6, 2009

@rugila:

A Howdy from Arizona

Say, I was in my 'near-death' laptop, but back on a decent PC today. Like you, I'm limited to Excel2003, so same rows.

Anyways, I ran into an issue where if we're real close to having the sheet full, q + resize stp can error, as its trying assign rows to 'a' that aren't there.

Probably something more graceful, but tacking the below under ReDim c(... seems to get it to right to the sheet's last row but no further.

 ReDim c(1 To stp, 1 To 1) '// Added ***********************************// If q + stp > Rows.Count Then '// stp = stp - ((stp + q) - Rows.Count) '// ReDim c(1 To stp, 1 To 1) '// End If '// '// End*************************************//

Hopefully my observation isn't daffy...

dougf said:
...The interesting part is that I also ran this macro for a test on a different data set, and the amount of time it took to process 773,000 rows was much more similar to your clocked times (11 seconds).

Doug:

It may help if you show good data examples; several strings of the stuff that works and several of the stuff that goes kaboom.

Not sure if this will work until we see the strings, but here was what I came up with. I should preface this with I know nil about RegExp, but this seems to find the stops/dots and replace them while still in the original strings. From there, I stayed with trying TextToColumns.

One downside, if a given val has two stops, both get replaced; as in ".2.2321" becomes "US.2US.232"; so this suggestion is only considerable if you know you'll have a max of one stop per element.

Option Explicit Sub Text2Col_ArrayGetChunks_ver3() Dim _ lLRow As Long, _ lRemainder As Long, _ lChunkCount As Long, _ i As Long, _ ii As Long, _ rngCurrent As Range, _ aryRange Dim REXP As Object '<--- RegExp 'Dim Start As Single: Start = Timer Const CHUNK_SIZE As Long = 10000 '<---Increase to suit. Set REXP = CreateObject("VBScript.RegExp") REXP.Global = True REXP.Pattern = "\." Application.ScreenUpdating = False With ActiveSheet 'Sheet2 lLRow = .Cells(Rows.Count, "D").End(xlUp).Row lChunkCount = lLRow \ CHUNK_SIZE lRemainder = lLRow Mod CHUNK_SIZE ReDim aryRange(1 To CHUNK_SIZE, 1 To 1) For i = 1 To lChunkCount Set rngCurrent = .Range(.Cells((i * CHUNK_SIZE + 1) - CHUNK_SIZE, "D"), _ .Cells(i * CHUNK_SIZE, "D")) aryRange = .Range(.Cells((i * CHUNK_SIZE + 1) - CHUNK_SIZE, "D"), _ .Cells(i * CHUNK_SIZE, "D")).Value For ii = LBound(aryRange, 1) To UBound(aryRange, 1) aryRange(ii, 1) = REXP.Replace(aryRange(ii, 1), "US.") Next rngCurrent.Value = aryRange rngCurrent.TextToColumns Destination:=rngCurrent(1, 1), _ DataType:=xlDelimited, _ TextQualifier:=xlTextQualifierNone, _ Other:=True, OtherChar:="~", _ FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), _ Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), _ Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), _ Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), _ Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array(25, 2), _ Array(26, 2), Array(27, 2), Array(28, 2), Array(29, 2), Array(30, 2), _ Array(31, 2), Array(32, 2), Array(33, 2), Array(34, 2), Array(35, 2)) Next If lRemainder > 0 Then Set rngCurrent = .Range(.Cells((i * CHUNK_SIZE + 1) - CHUNK_SIZE, "D"), _ .Cells(.Cells( _ (i * CHUNK_SIZE + 1) - CHUNK_SIZE, "D").Row _ + lRemainder - 1, "D" _ ) _ ) aryRange = .Range(.Cells((i * CHUNK_SIZE + 1) - CHUNK_SIZE, "D"), _ .Cells(.Cells( _ (i * CHUNK_SIZE + 1) - CHUNK_SIZE, "D").Row _ + lRemainder - 1, "D" _ ) _ ) For ii = LBound(aryRange, 1) To UBound(aryRange, 1) aryRange(ii, 1) = REXP.Replace(aryRange(ii, 1), "US.") Next rngCurrent.Value = aryRange rngCurrent.TextToColumns Destination:=rngCurrent(1, 1), _ DataType:=xlDelimited, _ TextQualifier:=xlTextQualifierNone, _ Other:=True, OtherChar:="~", _ FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), _ Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), _ Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), _ Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), _ Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array(25, 2), _ Array(26, 2), Array(27, 2), Array(28, 2), Array(29, 2), Array(30, 2), _ Array(31, 2), Array(32, 2), Array(33, 2), Array(34, 2), Array(35, 2)) End If End With Application.ScreenUpdating = True Set REXP = Nothing 'Debug.Print "Text2Col_ArrayGetChunks_ver3: " & Timer - Start End Sub

If the "US." part is not critical, this seems to go ok.

Sub Text2Col_GetChunks_ver2() Dim _ lLRow As Long, _ lRemainder As Long, _ lChunkCount As Long, _ i As Long, _ rngCurrent As Range Dim Start As Single: Start = Timer Const CHUNK_SIZE As Long = 10000 '<---Increase to suit. Application.ScreenUpdating = False With ActiveSheet 'Sheet2 lLRow = .Cells(Rows.Count, "D").End(xlUp).Row lChunkCount = lLRow \ CHUNK_SIZE lRemainder = lLRow Mod CHUNK_SIZE For i = 1 To lChunkCount Set rngCurrent = .Range(.Cells((i * CHUNK_SIZE + 1) - CHUNK_SIZE, "D"), _ .Cells(i * CHUNK_SIZE, "D")) rngCurrent.TextToColumns Destination:=rngCurrent(1, 1), _ DataType:=xlDelimited, _ TextQualifier:=xlTextQualifierNone, _ Other:=True, OtherChar:="~", _ FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), _ Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), _ Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), _ Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), _ Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array(25, 2), _ Array(26, 2), Array(27, 2), Array(28, 2), Array(29, 2), Array(30, 2), _ Array(31, 2), Array(32, 2), Array(33, 2), Array(34, 2), Array(35, 2)) Next If lRemainder > 0 Then Set rngCurrent = .Range(.Cells((i * CHUNK_SIZE + 1) - CHUNK_SIZE, "D"), _ .Cells(.Cells( _ (i * CHUNK_SIZE + 1) - CHUNK_SIZE, "D").Row _ + lRemainder - 1, "D" _ ) _ ) rngCurrent.TextToColumns Destination:=rngCurrent(1, 1), _ DataType:=xlDelimited, _ TextQualifier:=xlTextQualifierNone, _ Other:=True, OtherChar:="~", _ FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), _ Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), _ Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), _ Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), _ Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array(25, 2), _ Array(26, 2), Array(27, 2), Array(28, 2), Array(29, 2), Array(30, 2), _ Array(31, 2), Array(32, 2), Array(33, 2), Array(34, 2), Array(35, 2)) End If End With Application.ScreenUpdating = True Debug.Print "Text2Col_GetChunks_ver2: " & Timer - Start End Sub

Mark

GTO · Jul 6, 2009

ACK! I should at least put the string I was testing against...

65523 rows of...

.12341~LeadingDec~.D1234142~StopLeadLetter~.42424~LeadingDec~SomeWord~Text~.2.2321~LeadDecNumDecNum~.D.123~LeadDecLetterDecNum~xxx~xxx~xxx~xxx~xxx~xxx~xxx~xxx~xxx~.12312~LeadingDec

Mark

Legacy 14611 · Jul 7, 2009

Mark,

Thanx for howdy from Arizona.

Your observation (re overrunning worksheet rows) is certainly sensible enough. I didn't think it was likely with Excel 2007, which has max of 256*256*16 rows, if only 700,000 were being dealt with. I left doing anything more until it seemed the code otherwise satisfied OP.

Your solution seems OK, but I would rather confine the code to the used rows, rather than all rows of the sheet. Say by adding a couple of lines to my last posted code as

Rich (BB code):

...
n = Cells(Rows.Count, "d").End(xlUp).Row
For q = 1 To (Fix(n / stp) + 1) * stp Step stp
If q = n + 1 Then Exit For
If q > n + 1 - stp Then stp = n + 1 - q
ReDim c(1 To stp, 1 To 1)
a = Range("D" & q).Resize(stp, 1)
...

I had a look at your code. Uses Excel's Text-to-Columns and seems OK except for a bit of trouble with the US before period.

GTO · Jul 7, 2009

rugila said:
Mark,

Thanx for howdy from Arizona.

You bet

If you don't mind, whereabouts do you call home?

rugila said:
Your observation (re overrunning worksheet rows) is certainly sensible enough. I didn't think it was likely with Excel 2007, which has max of 256*256*16 rows, if only 700,000 were being dealt with. I left doing anything more until it seemed the code otherwise satisfied OP.

That certainly seems sensible. It didn't seem likely to cause the issue with OP's "it goes KABOOM!" string, but I figure no harm mentioning. Hope that is okay.

rugila said:
Your solution seems OK, but I would rather confine the code to the used rows, rather than all rows of the sheet. Say by adding a couple of lines to my last posted code as

Rich (BB code):

... n = Cells(Rows.Count, "d").End(xlUp).Row For q = 1 To (Fix(n / stp) + 1) * stp Step stp If q = n + 1 Then Exit For If q > n + 1 - stp Then stp = n + 1 - q ReDim c(1 To stp, 1 To 1) a = Range("D" & q).Resize(stp, 1) ...

Too late here to test that right now, plus currently on my "on life support" laptop, but will look this afternoon. Always nice to learn more/better ways

rugila said:
I had a look at your code. Uses Excel's Text-to-Columns and seems OK except for a bit of trouble with the US before period.

I guess we'll have to see if OP posts examples of "runs okay" and "run for yer lives!" strings, but seemed okay as long as only one stop in a given element. I was sorta hoping that Seiya or somenone blessed at RegExp would poke in and show a better pattern...

A great day to you and yours,

Mark

dougf · Jul 8, 2009

Mark, Peter, Rugila,

Thank you all for your help!

I've tried the formulas, and they all work fine on smaller subsets of the failing document as well as the larger 770k row doc.

I finally bit the bullet and copied 100,000 rows at a time to new documents. Then I ran the macro on each, with one window open at a time. The macro took about 40 seconds/file. Of course I can't combine the documents with copy and paste, but at least all the information is now "in Excel." MS should probably integrate any one of these new text to column replacements in a future version of Excel -- there is no reason why a common function such as TTC should produce instant out of memory errors.

Mark - nice pick up on the possible extra US/period replacements, but I think for this particular dataset all is still well.

If you're interested in the dataset that causes problems, I'd be happy to send you a copy if you happen to be personally interested. This is public data, so nothing proprietary (send me a PM). However, I know it will only be possible to open in Excel 2007.

Best,
Doug

dougf · Jul 15, 2009

I'm trying to repurpose the code now...

My data (after it has been run through a second macro) now looks like this:

Column A | Column B
Number1 | US.somenumber
Number1 | US.someothernumber
...
Number1 | .
Number2 | .
Number3 | US.somenumber
...

I'd like to run a text to columns macro on the second column based on "." so that I can separate the two letter prefix into its own column (which will later become the new column B after the modified Column B has been shifted over to column C).

However, there will then be many rows that only have periods in column B, and no other text or numbers. I do not want to lose the column A entry value if all of the rows with the same column A identifier do not have values for Column B.

Can you please help me write the macro to both convert text to columns based on "." and then remove rows that end up with no value in columns B & C (but keep the first instance if none of the rows for that value have a column B)? The sheet is already sorted by Column A.

In the end, the list should look as follows
Column A | Column B | Column C
Number1 | US | somenumber
Number1 | US | someothernumber
...

Number2 |
Number3 | US | somenumber
...

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

dougf

New Member

dougf

New Member

Excel Facts

Legacy 14611

Guest

dougf

New Member

Legacy 14611

Guest

GTO

MrExcel MVP

GTO

MrExcel MVP

Legacy 14611

Guest

GTO

MrExcel MVP

dougf

New Member

dougf

New Member

Similar threads

Forum statistics

Share this page

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

New Member

New Member

Excel Facts

Legacy 14611

Guest

New Member

Legacy 14611

Guest

MrExcel MVP

MrExcel MVP

Legacy 14611

Guest

MrExcel MVP

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock