Here is some code for you. Instead of traversing column J looking for the
values in R it uses the Find function which will be a pile more efficient.
Here is how it works It traverses thour the cells in Column R and passes the
cell and the range to be searched (Column J) to the function FoundCells. the
function FoundCells performs the Search and returns a Range object made up of
all of the cells that it found. That range object is coloured red and copied
to sheet 2...

Sub FindStuff()
Dim rngStringsToFind As Range
Dim rng As Range
Dim rngToSearch As Range
Dim rngFoundCells As Range

Set rngStringsToFind = Range(Range("R2"), Cells(Rows.Count,
"R").End(xlUp))
Set rngToSearch = Columns("J")

For Each rng In rngStringsToFind
Set rngFoundCells = FoundCells(rngToSearch, rng)
If Not rngFoundCells Is Nothing Then
rngFoundCells.Font.ColorIndex = 3
rngFoundCells.Copy _
Destination:=Worksheets("Sheet2").Cells(Rows.Count ,
"A").End(xlUp).Offset(1, 0)
Set rngFoundCells = Nothing
End If
Next rng
End Sub

Private Function FoundCells(ByVal rngToSearch As Range, _
ByVal rngStringToFind As Range) As Range
Dim rngFound As Range
Dim strFirstAddress As String

Set FoundCells = Nothing
Set rngFound = rngToSearch.Find(What:=rngStringToFind.Value, _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
MatchCase:=False)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Set FoundCells = rngFound
Do
Set FoundCells = Union(rngFound, FoundCells)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If

End Function
--
HTH...

Jim Thomlinson


"Janis" wrote:

I have a string in each cell in column R. I want to see if there is a match
in each cell in column J. In column J there are one or more strings
delimited by a comma.
I am having trouble with the inner loop how to set the stringsearch. IF
there is a match I want to mark it in red and copy it to a column in another
sheet. tia,


Sub SDelete()
Dim ColumnJ As Range
Dim ColumnR As Range
Dim stringToSearch As String

Dim I As Integer
Dim C As Cell

Set J = ActiveSheet.Range("J2:end.xl(down)")

Set R = ActiveSheet.Range("R2:end.xl(down)")


I = 2

For Each C In ColumnR

'compare cell in ColumnR with each string in columnJ deliminated by commas
Set C = ("R" & I)


'compare cell in ColumnR with each string in ColumnJ
For Each stringToSearch In ColumnJ
Set stringToSearch = XXXXX
If stringToSearch = C Then

'if it matches color font red
C.Font.ColorIndex = 3
C.Copy Destination:=Worksheets("Sheet2").Range("5")

Else
Next




End If
I = I + 1


Next C


End Sub