CODEWITHSUNDEEP
vbatext-to-column
isomericharsh
isomericharsh

Reputation: 83

How to separate words from single column

I am trying to read data from a text file using excel/VBA. However when i import the file all the words are in the same column. The text is generated from PDF while preserving the table layout. So the words are space delimited, but the spacing is not consistent. I want code to run through cells and separate the words. Two things are true however for the cells

  1. single words have one spacing
  2. words are separated by two or more spaces

Screenshot 1 Screenshot 2

Upvotes: 1

Views: 93

Answers (3)

isomericharsh
isomericharsh

Reputation: 83

Thanks @Uri Goren @Kenusemau. Posting Answer for anyone else looking for the same issue.

Sub Macro2()
Const marker As String = "#$"
Dim rx, s As String, t As String, parts
Set rx = CreateObject("vbscript.regexp")

For A_row = 1 To 2 ' Last row t o consider
    s = Range("A" & A_row)
        rx.Pattern = " {2,}" ' match two or more spaces
        rx.Global = True ' find all, not only the first match
        t=rx.Replace(s, marker)
        Range("B" & A_row).Value = t
        'parts = Split(t, marker)
        'Range("B" & A_row).Value = Join(parts, vbCrLf)
                Range("B" & A_row).Select
                Selection.TextToColumns _
                Destination:=Range("C" & A_row), _
                DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, _
                Tab:=True, _
                Semicolon:=False, _
                Comma:=False, _
                Space:=False, _
                Other:=True, _
                OtherChar:="#$"
Next A_row
End Sub

Upvotes: 1

KekuSemau
KekuSemau

Reputation: 6852

I understand that the core challenge is to split by 2+ spaces, but not by one.

Try if this helps you on that:

Const marker As String = "[!°$(])"
Dim rx, s As String, t As String, parts
Set rx = CreateObject("vbscript.regexp")

s = "One Cell   Red  Green"

rx.Pattern = " {2,}" ' match two or more spaces
rx.Global = True ' find all, not only the first match
t = rx.Replace(s, marker)

parts = Split(t, marker)
MsgBox Join(parts, vbCrLf)

Upvotes: 1

Uri Goren
Uri Goren

Reputation: 13700

This code takes the first 100 cells in column A, split their content by space, and pastes it to column B

Dim A_row As Integer, B_row as Integer, i As Integer, words()
For A_row = 1 To 100' Last row t o consider
    words = Split(Range("A" & A_row), " ")
    For i = LBound(words) To UBound(words)
        B_row = B_row + 1
        Range("B" & B_row) = words(i)
    Next i
Next A_row

I'm sure you could get the gist, and modify it to your needs

Upvotes: 1

Related Questions