help with inner loop to search for matching strings

[Janis]

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

 

[Jim Thomlinson]

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

 

[Janis]

this was very urgent, thanks for the rescue.

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

 

[Janis]

Jim
That really got me out of hot water. I do okay if I don't have any last
minute requests. wow thanks again. Janis

 

[Jim Thomlinson]

Glad to help and glad to see your code is improving. Pretty soon you will be
handling the last minute request in stride...

Things to note in your code. You do not need to use the Set key word on
string variables (or other regular variables). Set is only required with
objects like ranges and worksheets. When you are creating ranges with
variables or using methods like xlDown don't include the variable/method in
quotes.

 

[Janis]

thanks for this note.

Glad to help and glad to see your code is improving. Pretty soon you will be
handling the last minute request in stride...

Things to note in your code. You do not need to use the Set key word on
string variables (or other regular variables). Set is only required with
objects like ranges and worksheets. When you are creating ranges with
variables or using methods like xlDown don't include the variable/method in
quotes.