Solved: Extract Text to columns

[James Niven]

Hi All,

I have an access database of Radio station on AMFM band. I wish to update the information contained from an excel file.

I have done a pretty good search of the forum and I have found a few threads that come close to what I want, but not quite.

I have text in this form NJ Port Republic 88.7 WXXY WEHA in one cell "A3" but want to split it into separate columns in excel.

Can someone suggest code that will do this task, this will be repeated month over month!!

I have attached a sample excel file.

Thanks

James Niven
Cedar Creek, TX

[tpoynton]

if the towns didnt sometimes have two words, text to columns would work...I have put together this as a start, but I'm not up on my text functions and it's too late for me to figure it out and finish, so I thought I'd put what I have here.


Sub MyTextToColumns()
Dim dataRange As Range
Dim cell As Range
Dim i As Long
Dim spaceCount As Long
With ActiveSheet
Set dataRange = .Range(Cells(3, 1), Cells(.UsedRange.Rows.Count, 1))
End With
Application.DisplayAlerts = False 'prevents replace dest cells msg
For Each cell In dataRange
spaceCount = 0
For i = 1 To Len(cell.Value)
If Mid(cell.Value, i, 1) = Chr(32) Then
spaceCount = spaceCount + 1
End If
Next i
If spaceCount < 5 Then
cell.TextToColumns Destination:=cell.Offset(, 3), DataType:=xlDelimited, Space:=True
Else 'town has a space
With cell
.Offset(, 3).Value = Left(.Value, 2)
End With
End If
i = 0
Next cell
Application.DisplayAlerts = True
End Sub


There probably is a more efficient way to do this; I'm all ears!

[Tinbendr]

Here's my try.
Sub RadioStationParse()

Dim DataRange As Range
Dim aCell As Range
Dim Pos As Integer

'Set the range
With ActiveSheet
Set DataRange = .Range(Cells(3, 1), Cells(.UsedRange.Rows.Count, 1))
End With

'Loop through each cell with the long string.
For Each aCell In DataRange
'Replace the Spaces with Commas
aCell = Replace(aCell, " ", ",")
'You can use the Split to break the string into an Array.
'UBound then contains the total number of elements.
'If there are five then the City must have two names.
If UBound(Split(aCell, ",")) = 5 Then
'We know that the second comma is beyond position 4
'so we start counting from there looking for it.
Pos = InStr(4, aCell, ",")
'Build a string back without the extra comma
aCell = Left(aCell, Pos - 1) & " " & Right(aCell, Len(aCell) - Pos)
End If
Next
'Convert the comma delimit string into columns.
DataRange.TextToColumns DataType:=xlDelimited, comma:=True

End Sub

[Bob Phillips]

With formulae:

E3: =LEFT(A3,FIND(" ",A3)-1)
F3: =TRIM(LEFT(SUBSTITUTE(SUBSTITUTE(A3,E3,""),H3,""),FIND(" ",TRIM(SUBSTITUTE(SUBSTITUTE(A3,E3,""),H3,"")))))
G3: =TRIM(SUBSTITUTE(SUBSTITUTE(TRIM(SUBSTITUTE(A3,E3,"")),F3,""),H3,""))
H3: =MID(A3,FIND(CHAR(1),SUBSTITUTE(A3," ",CHAR(1),LEN(A3)-LEN(SUBSTITUTE(A3," ",""))-1))+1,255)

[mdmackillop]

Sub DoSplit()
Dim cel As Range, p, i As Long, j As Long, txt As String
For Each cel In Selection
txt = ""
p = Split(cel)
cel.Offset(, 3) = p(0)
For i = 1 To UBound(p)
If Not IsNumeric(p(i)) Then
txt = txt & " " & p(i)
Else
cel.Offset(, 4) = Trim(txt)
cel.Offset(, 5) = p(i)
txt = ""
For j = i + 1 To UBound(p)
txt = txt & " " & p(j)
Next
cel.Offset(, 6) = Trim(txt)
End If
Next
Next
End Sub

[James Niven]

Thank you for your example Tpoynton. Your example did do what I asked, but any cities with two names, it did not process them.
Thank you for your example Tinbendr. Your example did do what I asked, and works very well. Would you be able to break the code down for a newbie?
Thank you for your example mdmackillop. Your example did do what I asked, but it did not separate the last two items on the end of each line.
I have different variations of the example I submitted and would love to learn how I can modify to suit.

Also, has there been any thought and running online tutorials on this site for newbies/raw beginners on the basics of VBA?

Thanks

James Niven
Cedar Creek, TX

[mdmackillop]

Easily fixed

Sub DoSplit()
Dim cel As Range, p, i As Long, j As Long, txt As String
For Each cel In Selection
txt = ""
p = Split(cel)
cel.Offset(, 3) = p(0)
For i = 1 To UBound(p)
If Not IsNumeric(p(i)) Then
txt = txt & " " & p(i)
Else
cel.Offset(, 4) = Trim(txt)
cel.Offset(, 5) = p(i)
txt = ""
For j = 1 To UBound(p) - i
cel.Offset(, 5 + j) = p(i + j)
Next
End If
Next
Next
End Sub

[mdmackillop]

Hi James,
The basic thing to learn is not really VBA, but to split your task into simple steps. Once you have this logic, you can build up the VBA around it.
In the case of my code

For each item:
Split it into separate “words”
The first Word is the first item
Join the next words into a string until a number is found
Put this joined text as the next value
Put the Number as the next value
Put the remaining Words as the remaining values

[Tinbendr]

James,

I've gone back and added more comments.

Place your cursor over the Keywords you don't understand and press F1.

If you have specific questions, please post back.

[James Niven]

mdmackillop, thanks for the advice, I will follow your steps next time.

Tinbendr, thanks for the more detailed instructions on your code example, very helpful for this newbie!!

Thanks

James