Solved: Add Text to Old Call/New Call

[James Niven]

When I run this code, it does what I am wanting it to do for tab named 11-01-2009. What I want to do now is add -FM to the end of the Old and New Call columns if it does not already exist and -LP needs to stay also if present. Here is an example of what I want:

IAStory City88.3 KJTT-FMKHOI-FM11/1/2009

I have attached an example.

Thanks

James

[GTO]

Hi James,

In a test copy, try:

Sub RadioStationParse()

Dim DataRange As Range
Dim aCell As Range
Dim Pos As Integer, lst As Integer, temp As String

'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
'Insert Column Headings
Cells(3, 1).Value = "State"
Cells(3, 2).Value = "City"
Cells(3, 3).Value = "Freq"
Cells(3, 4).Value = "Old Call"
Cells(3, 5).Value = "New Call"
Cells(3, 6).Value = "Date"
'Insert Sheet Name
lst = ActiveSheet.Columns(1).Rows(10000).End(xlUp).Row
temp = ActiveSheet.Name
Range(Cells(4, 6), Cells(lst, 6)) = temp
Columns("F").HorizontalAlignment = xlCenter
Columns("F").VerticalAlignment = xlTop

'// ADD //
Set DataRange = Range(Cells(4, 4), Cells(lst, 5))

'// Then to tack -FM onto any entry lacking... //
' For Each aCell In DataRange
' If Len(aCell.Value) > 3 _
' And InStr(4, aCell.Value, "-FM", vbTextCompare) = 0 Then
' aCell.Value = aCell.Value & "-FM"
' End If
' Next
'// or if you meant that if "-LP" exists, then just leave it alone... //
For Each aCell In DataRange
If Len(aCell.Value) > 3 _
And InStr(4, aCell.Value, "-FM", vbTextCompare) = 0 _
And InStr(4, aCell.Value, "-LP", vbTextCompare) = 0 Then
aCell.Value = aCell.Value & "-FM"
End If
Next
End Sub


Hope that helps,

Mark

[James Niven]

GTO,

Works like a charm, thanks for much!!

So, I take it the first part of the code which is commented out is not needed?

James

[GTO]

Hi James,

If you are referring to:


'// Then to tack -FM onto any entry lacking... //
' For Each aCell In DataRange
' If Len(aCell.Value) > 3 _
' And InStr(4, aCell.Value, "-FM", vbTextCompare) = 0 Then
' aCell.Value = aCell.Value & "-FM"
' End If
' Next


I was offering a choice, as I wasn't quite sure if...

...add -FM to the end of the Old and New Call columns if it does not already exist and -LP needs to stay also if present...

...meant that '-FM' would be tacked onto entries that already had '-LP' attached.

The rem'd bit would change:
KOOL-LP
to:
KOOL-LP-FM

Mark

[James Niven]

GTO,

Your assumption was correct, if -LP is existing then no -FM would be tacked on to the end.

Thanks, as always you came through for me.

James

[James Niven]

GTO,

I have found instants of call Letters greater than 5 characters in length, but I do not want -FM tacked on the end. Using your code which works great, how would I accomplish this.



'// Then to tack -FM onto any entry lacking... //
' For Each aCell In DataRange
' If Len(aCell.Value) > 3 _
' And InStr(4, aCell.Value, "-FM", vbTextCompare) = 0 Then
' aCell.Value = aCell.Value & "-FM"
' End If
' Next


James

[Bob Phillips]

'// Then to tack -FM onto any entry lacking... //
' For Each aCell In DataRange
' If Len(aCell.Value) > 3 And Len(aCell.Value <= 4 _
' And InStr(4, aCell.Value, "-FM", vbTextCompare) = 0 Then
' aCell.Value = aCell.Value & "-FM"
' End If
' Next

[James Niven]

XLD,

This is what I wanted!!

Thanks