Delete All Characters in Text String After xxxxx - HELP!

  • Thread starter Thread starter Paige
  • Start date Start date
P

Paige

I have a column of data like:

2345 1st Street PO Box 123
12 South Boulevard Mr. Smith
3241 East Tenth Drive PO123123123

Need to go down the column and wherever it finds the word 'street',
'boulevard' or 'drive', delete all the characters AFTER that word. Can
someone help with a VBA resolution to this please?
 
You don't need VBA code for this.

Use column B to see at which character the word Street occurs (if it
occurs). In columns C & D, do the same for the 2 other words. In column E,
ask for the minimum of the 3 cells to the left. Lastly, column F, using the
LEFT and LEN functions, get the x left most characters of column A.
 
Something like this. Just fill in your Boulevard and Drive code.

Sub test()

Dim i As Long
Dim arr
Dim lPos As Long

arr = Range(Cells(1), Cells(10, 1))

For i = 1 To UBound(arr)
lPos = InStr(1, UCase(arr(i, 1)), "STREET", vbBinaryCompare)
If lPos > 0 Then
arr(i, 1) = Left$(arr(i, 1), lPos + 5)
End If
Next i

Range(Cells(1), Cells(10, 1)) = arr

End Sub


RBS
 
Thanks, Wigi. I can do with formulas, but it is ugly because there are
actually more than just 3 things to look for, so really would like a VBA
solution if possible.
 
Hello there

Here you go.


Sub stripafterwords()

Const sWord1 As String = "street"
Const sWord2 As String = "boulevard"
Const sWord3 As String = "drive"

Dim r As Range


For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))

r.Value = afterdeleting(CStr(r.Value), sWord1)
r.Value = afterdeleting(CStr(r.Value), sWord2)
r.Value = afterdeleting(CStr(r.Value), sWord3)

Next

End Sub

Function afterdeleting(s As String, sSpecialWord As String) As String

Dim i As Long

i = InStr(s, sSpecialWord)

If i Then
afterdeleting = Trim(Left(s, i - 1 + Len(sSpecialWord)))
Else
afterdeleting = s
End If

End Function
 
WOW - You are WUNDERBAR!! Thank you thank you!

Wigi said:
Hello there

Here you go.


Sub stripafterwords()

Const sWord1 As String = "street"
Const sWord2 As String = "boulevard"
Const sWord3 As String = "drive"

Dim r As Range


For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))

r.Value = afterdeleting(CStr(r.Value), sWord1)
r.Value = afterdeleting(CStr(r.Value), sWord2)
r.Value = afterdeleting(CStr(r.Value), sWord3)

Next

End Sub

Function afterdeleting(s As String, sSpecialWord As String) As String

Dim i As Long

i = InStr(s, sSpecialWord)

If i Then
afterdeleting = Trim(Left(s, i - 1 + Len(sSpecialWord)))
Else
afterdeleting = s
End If

End Function
Click to expand...
 
Back
Top