![]() |
Matching Text
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 :confused: 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 -- KH_G ----------------------------------------------------------------------- KH_GS's Profile: http://www.excelforum.com/member.php...fo&userid=3292 View this thread: http://www.excelforum.com/showthread.php?threadid=52911 |
Matching Text
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 KH_GS schrieb: 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 :confused: 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 -- KH_GS ------------------------------------------------------------------------ KH_GS's Profile: http://www.excelforum.com/member.php...o&userid=32920 View this thread: http://www.excelforum.com/showthread...hreadid=529110 |
Matching Text
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 ------------------- -- gti_jober ----------------------------------------------------------------------- gti_jobert's Profile: http://www.excelforum.com/member.php...fo&userid=3063 View this thread: http://www.excelforum.com/showthread.php?threadid=52911 |
Matching Text
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. -- Regards, Tom Ogilvy "gti_jobert" wrote: 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 -------------------- -- gti_jobert ------------------------------------------------------------------------ gti_jobert's Profile: http://www.excelforum.com/member.php...o&userid=30634 View this thread: http://www.excelforum.com/showthread...hreadid=529110 |
Matching Text
On Mon, 3 Apr 2006 02:53:55 -0500, KH_GS
wrote: 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 :confused: 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 |
All times are GMT +1. The time now is 04:59 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com