Matching Text

[KH_GS]

Hi

I have a column containing text phrases in each cell, if there's an
word in the cell ends with "abc", I want that phrase to be in a ne
column.

Data in each cell:
appleabc is not red
roadabc is long
green apple
roadblock
apple is fruitabc
sweet fruit

Output(in a new column):
appleabc is not red
roadabc is long
apple is fruitabc


Here's the code that doesn't work

Sub PrintEnd_ING()
Dim Cell As Range
Dim myString As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False

x = ActiveCell.Row
y = ActiveCell.Column

For Each Cell In Range(Selection, Selection.End(xlDown))

myString = Cells(x, y).Value
If myString Like "*abc" Or myString = "*abc? " Then

ActiveSheet.Cells(x, y + 3).Value = myString
ActiveSheet.Cells(x, y + 4).Value = Cell.Offset(0, 1).Value
x = x + 1

End If
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Su

 

[heribert]

Hi KH_GS,

maybe this works:

Public Sub abc()
Dim myString As String
Dim searchString As String
searchString = "abc"

Dim x As Range
For Each x In Selection
myString = CStr(x.Value)
sp = Split(myString, " ")

For Each s In sp
If Right(s, Len(searchString)) = searchString Then
x.Offset(0, 1).Value = myString
End If
Next
Next

End Sub

 

[gti_jobert]

Or this;


Code
-------------------

Dim arrayMax%, Arry()

Erase Arry()
i = ActiveCell.Row
j = ActiveCell.Column

'Collect all value into array
Do
Cells(i, j).Select
If InStr(ActiveCell.Value, "abc") Then
arrayMax = arrayMax + 1
ReDim Preserve Arry(1 To arrayMax)
Arry(arrayMax) = ActiveCell.Value
End If
i = i + 1
Loop Until Cells(i, j).Value = ""

'loop values out of array into new colum
i = 1
j = ActiveCell.Column + 1
Do
Cells(i, j).Value = Arry(i)
i = i + 1
Loop Until i = arrayMax + 1

 

[Guest]

The logic you use with Instr will cause the string to be added even if the
"abc" doesn't appear at the end of the word.

 

[Ron Rosenfeld]

Hi

I have a column containing text phrases in each cell, if there's any
word in the cell ends with "abc", I want that phrase to be in a new
column.

Data in each cell:
appleabc is not red
roadabc is long
green apple
roadblock
apple is fruitabc
sweet fruit

Output(in a new column):
appleabc is not red
roadabc is long
apple is fruitabc


Here's the code that doesn't work

Sub PrintEnd_ING()
Dim Cell As Range
Dim myString As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False

x = ActiveCell.Row
y = ActiveCell.Column

For Each Cell In Range(Selection, Selection.End(xlDown))

myString = Cells(x, y).Value
If myString Like "*abc" Or myString = "*abc? " Then

ActiveSheet.Cells(x, y + 3).Value = myString
ActiveSheet.Cells(x, y + 4).Value = Cell.Offset(0, 1).Value
x = x + 1

End If
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

With all these variations in string processing that you've been posting, you
might do better by implementing Regular Expressions to define your string.

Here's an example. It requires setting a reference in the VB Editor (see the
Tools/References item from the main menu) to "Microsoft VBScript Regular
Expressions 5.5" which should show up in the list.

Also, you may want to change Src and Dest and how you derive them.

The routine will move the contents of cells that meet your test into the Dest
column and not leave blanks.

If you want to have blanks for cells that don't make the test, that's easy to
do also.

I believe the routine is documented well enough so that you can understand the
basic principals. But you may have to do some research for info on
constructing Regular Expressions. In the below the portion of Pattern that is
"\b" means the end of a word. So "abc\b" means any sequence of "abc" followed
by a word boundary.

Just another approach.

======================================================
Option Explicit

Sub ING()
'set up to use Regular Expressions
Dim objRegExp As RegExp

'set a pattern to look for words ending in "abc"
Const Pattern As String = "abc\b"

Dim c As Range
Dim Src As Range, Dest As Range
Dim i As Long

' Create a regular expression object.
Set objRegExp = New RegExp

'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern

' Set Case Insensitivity.
objRegExp.IgnoreCase = True

'Set global applicability.
objRegExp.Global = True


Set Src = [a1:a100]
'Clear and Set Dest
Set Dest = Src.Offset(0, 1)
Dest.Clear
Set Dest = Dest.Resize(1, 1)

For Each c In Src

'Test whether the String can be compared.
If objRegExp.Test(c.Text) = True Then
Dest.Offset(i, 0).Value = c.Value
i = i + 1
End If
Next c

End Sub
===============================

--ron