append data to blank column based on find feature

[nick1218]

I want to do something similar to the find feature. To find text in a cell even if that text is in the middle of the word. For example I might search for "ing" and a row with the word "washington" would match because ing is in the middle of washington. But when it does find a match I need something, anything, to be added to a designated blank column in the same row.

 

[GTO]

Greetings,

Let's say you the below in cells A1:A10 of "Sheet2".

<TABLE style="WIDTH: 57pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=76 border=0 x:str><COLGROUP><COL style="WIDTH: 57pt; mso-width-source: userset; mso-width-alt: 2779" width=76><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 57pt; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" width=76 height=17>Apple</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>Pear</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>Washington</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>Lloyd</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>Bear</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>Nearing</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>Peachy</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>Dog</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>Cat</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>Horse</TD></TR></TBODY></TABLE>

The below would put the word "MARKER" in cells C3 and C6.

In a Standard Module:

Option Explicit
Sub MarkIt()
Dim rngSearchArea As Range
Dim rCell As Range
Dim strAddress As String
 
    Set rngSearchArea = ThisWorkbook.Worksheets("Sheet2").Range("A1:A10")
    
    With rngSearchArea
    
        Set rCell = .Find(What:="ing", LookIn:=xlValues, LookAt:=xlPart)
            
        If Not rCell Is Nothing Then
            strAddress = rCell.Address
            
            Do
                rCell.Offset(, 2).Value = "MARKER"
                
                Set rCell = .FindNext(rCell)
            Loop While Not rCell.Address = strAddress
        End If
    End With
    
End Sub

This is pretty much straight from the help topic, excepting dropping what seemed to be a goofy second check for the While.

Hope this helps,

Mark