Text to Columns with multi-character delimiters

[Dave B]

I have text files with tables that were created using lots of spaces to
give the appearance of columns (when viewed with a monospace font).
I'm trying to split this text to columns in Excel, but there are two
complications: (1) sometimes the text is not lined up right, and (2)
sometimes text from the first column spills over into other columns.
I'm not sure if this will display in the newsgroup in monospace, but
here's an example:

Heading1 Heading2 Heading3
123456 987654 101010
This text spills over into other columns
ThisData IsNot LinedUpRight
123456 987654 101010

Because of the complications, I can't split using fixed width. One
thing that is constant is there is always *multiple* spaces between
cell data. So I could do TextToColumns for TWO SPACES IN A ROW, like:

Selection.TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlNone, _
ConsecutiveDelimiter:=True, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=True, _
OtherChar:=" ", _
FieldInfo:=Array(1, 1)

except the TextToColumns function only uses the first character (won't
allow multicharacter delimiters). Does anyone have any ideas? Does
anyone have the code behind the TextToColumns function? I could just
modify it to allow multicharacter delimiters. I have also thought of
finding and replacing multiple spaces with some unique character like
{, then using "{" as my delimiter. Minimum coding required for me but
seems pretty sloppy.

Thanks in advance for your help.

 

[Patrick Molloy]

you could read each line in from the text file, the replace the double spaces
until they're all gone...

say TXT is a text stream opject opened to your file.. and WS is set to the
output worksheet

Sub looper()
Dim TXT As TextStream
Dim text As String
Dim index As Long

With TXT
Do Until .AtEndOfStream
index = index + 1
text = .ReadLine
Do
text = Replace(text, " ", " ")
Loop While InStr(text, " ") > 0
ws.Cells(index, 1) = text
Loop
.Close
End With

End Sub

 

[Guest]

Load your strings into Col A
Run the sub below
Delete Column A
You're done:

Option Explicit
Option Compare Text

Sub MakeColumns()
Dim i As Long 'Current Row
Dim j As Long 'Numerical Column index
Dim n As Long 'String length
Dim s As String 'String to parse

For i = 1 To Range("A65536").End(xlUp).Row
s = Cells(i, 1) 'Get the unparsed string
j = 2 'Start puting results in Col B
While InStr(s, " ") <> 0 'Do while string contains multiple
spaces
n = InStr(s, " ") 'Find 1st occurance of 2 or more spaces
Cells(i, j) = Left(s, n - 1) 'Save all chars before " " in
next col
s = Trim(Right(s, Len(s) - n)) 'Get rid of leading spaces for
next pass
j = j + 1 'Save results of next pass in the next column
Wend
Cells(i, j) = Trim(s) 'Save remaining part of string
Next i
End Sub