![]() |
help with inner loop to search for matching strings
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 |
help with inner loop to search for matching strings
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 |
help with inner loop to search for matching strings
this was very urgent, thanks for the rescue.
"Jim Thomlinson" wrote: 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 |
help with inner loop to search for matching strings
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" wrote: 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 |
help with inner loop to search for matching strings
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. -- HTH... Jim Thomlinson "Janis" wrote: 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" wrote: 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 |
help with inner loop to search for matching strings
thanks for this note.
"Jim Thomlinson" wrote: 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. -- HTH... Jim Thomlinson "Janis" wrote: 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" wrote: 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 |
All times are GMT +1. The time now is 07:17 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com