Search for text and highlight row

[TaskMaster]

Hi all I have the following that sequentially searches for FB09 and copies the data to another tab, I would like the row of the data being copied to be highlighted a colour as a check to tell me that data has being picked up. Is there a way to tweak this to do this?

Sub FindAndCopyM()
    Dim WS1 As Worksheet, WS2 As Worksheet
    Dim R As Range, SearchRange As Range
    Dim S As String, SearchStr As String ,FirstAddr As String
    Dim LastRow As Long
    Dim FirstPass As Boolean

    Set WS1 = Worksheets("data")
    Set WS2 = Worksheets("summary")

    SearchStr = "FB09"

    Set SearchRange = WS1.Range("S1", WS1.Range("S" & WS1.Rows.Count).End(xlUp))

    With SearchRange
        Set R = .Find(what:=SearchStr, after:=.Cells(.Cells.Count), lookat:=xlPart, MatchCase:=True, searchdirection:=xlNext)
    End With

    If Not R Is Nothing Then
        FirstAddr = R.Address
        FirstPass = True
    End If

    Do While Not R Is Nothing
        If Not FirstPass Then
            Set R = SearchRange.Find(what:=SearchStr, after:=R, lookat:=xlPart, MatchCase:=True, searchdirection:=xlNext)
        End If

        If Not FirstPass Then
            If R.Address = FirstAddr Then
                Set R = Nothing
                Exit Do
            End If
        Else
            FirstPass = False
        End If
       
        If Not R Is Nothing Then
            If InStr(R.Value, SearchStr) = 1 Then
                S = Right(R.Value, 8)
                If WS2.Range("A23").Value = "" Then
                    WS2.Range("A23").NumberFormat = "@"
                    WS2.Range("A23").Value = S
                Else
                    With WS2
                        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
                         .Range("A" & LastRow + 1).NumberFormat = "@"
                        .Range("A" & LastRow + 1).Value = S
                    End With
                End If
            End If
        End If
    Loop
End Sub

 

[iliace]

First and third line is in your existing code, add the one in between.

If InStr(R.Value, SearchStr) = 1 Then
                R.Interior.Color = 65535
                S = Right(R.Value, 8)

 

[TaskMaster]

First and third line is in your existing code, add the one in between.

If InStr(R.Value, SearchStr) = 1 Then
                R.Interior.Color = 65535
                S = Right(R.Value, 8)

Hi thank you for your reply, this works brilliantly, however would it be possible for it to highlight the whole row, columns A:AA?

 

[Joe4]

Just change this line:

R.Interior.Color = 65535

to this:

Range(Cells(R.Row, "A"),Cells(R.Row, "AA")).Interior.Color = 65535

 

[TaskMaster]

Just change this line:

R.Interior.Color = 65535

to this:

Range(Cells(R.Row, "A"),Cells(R.Row, "AA")).Interior.Color = 65535

This is perfect thank you

 

[Joe4]

You are welcome.
Glad we were able to help!