Copy or move rows that are highlighted based on conditions.

[suzinger]

Hello!

I moved a database from an old DOS-based program to an excel worksheet. I used conditional formatting so that someone can search all cells for any term and the row where that term is found is highlighted in yellow.

I would like to know how to do the following (if it is possible):
*Enter search term
*Rows with term in any cell are highlighted yellow. Table is 217 Rows x 6 Columns.
THEN -
*EITHER - 1. Automatically copy all the highlighted rows to another sheet OR 2. Move the highlighted rows to the top of the table.
*This sort/move will happen each time a new search terms is entered.

The end result I am trying to achieve is that someone can do a search and not have to scroll through the table to find the rows highlighted in yellow. I am open to any suggestions on how to achieve this goal.

Thank you for your time and assistance!

 

[My Aswer Is This]

Try this.

Now it will see "George is a nice guy" as a find if you enter "George" in the Inputbox.

Sub Check_Rows_New()
'Modified 2/1/17 6:00 PM EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long
Dim c As Range
Dim MyValue As String
MyValue = InputBox("Enter value to search for")
Lastrow = Sheets("MyData").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets("New").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("MyData").Activate
    For i = 1 To Lastrow
        For Each c In Range("A" & i & ":F" & i)
            
            
            If InStr(c.Value, MyValue) Then
                Rows(i).Copy Destination:=Sheets("New").Rows(Lastrowa)
                Rows(i).Cells.Interior.ColorIndex = 6
                Lastrowa = Lastrowa + 1
            End If
        Next
    Next
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Mark:

Why did you use:

If InStr([COLOR=#FF0000]1[/COLOR], c.Value, MyValue, [COLOR=#FF0000]1[/COLOR]) Then

While I used:

If InStr(c.Value, MyValue) Then

This should allow for "geo" in a mixed text string.
However, this could cause issues, if you were looking for George and Geography was in the cell. I'd suggest keeping your search as accurate as possible

Sub Check_Rows()
Application.ScreenUpdating = False
Dim i As Long, Lastrow As Long, Lastrowa As Long
Dim MyValue As String, c As Range
MyValue = InputBox("Enter value to search for")
Lastrow = Sheets("MyData").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets("New").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("MyData").Activate
    For i = 1 To Lastrow
        For Each c In Range("A" & i & ":F" & i)
            If InStr(1, c.Value, MyValue, 1) Then
                Rows(i).Copy Destination:=Sheets("New").Rows(Lastrowa)
                Rows(i).Cells.Interior.ColorIndex = 6
                Lastrowa = Lastrowa + 1
            End If
        Next
    Next
Application.ScreenUpdating = True
End Sub

 

[Michael M]

Assuming your query is directed back to me...
The first "1" is the Start number of the search
The 2nd "1" is to force it to compare Text

 

[My Aswer Is This]

Thanks. Sorry Michael not Mark.

Assuming your query is directed back to me...
The first "1" is the Start number of the search
The 2nd "1" is to force it to compare Text

 

[suzinger]

Thank you for the revised code. Based on your revision, would "Where is George?" be a find or only phrases that start with with the word George?

 

[suzinger]

Thank you so much for your time and assistance Michael M! Yes, I see it does present a problem if the search is not specific. For example, if my search term appears in two columns in the same row the row is copied twice.

I sincerely appreciate all the time and effort everyone has contributed to this question.

 

[suzinger]

"Sub Check_Rows()
Application.ScreenUpdating = False
Dim i As Long, Lastrow As Long, Lastrowa As Long
Dim MyValue As String, c As Range
MyValue = InputBox("Enter value to search for")
Lastrow = Sheets("MyData").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets("New").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("MyData").Activate
For i = 1 To Lastrow
For Each c In Range("A" & i & ":F" & i)
If InStr(1, c.Value, MyValue, 1) Then
Rows(i).Copy Destination:=Sheets("New").Rows(Lastrowa)
Rows(i).Cells.Interior.ColorIndex = 6
Lastrowa = Lastrowa + 1
End If
Next
Next
Application.ScreenUpdating = True
End Sub"


Thank you Michael M! This works very well!

Would it be possible to tweak it a little so that it does not copy a row more than once if the search term is in more than one column per row?

Example: Col A - Name, Col B - Email
George george@email.com

Maybe it could stop searching the row after the search term makes a find (just thinking out loud)?

You are sincerely appreciated!

 

[Michael M]

Try this.....
AND
for future use, can you please use code tags...When posting code, highlight the code and then click on the Hash # button in the title bar of the message

Sub Check_Rows()
Application.ScreenUpdating = False
Dim i As Long, Lastrow As Long, Lastrowa As Long
Dim MyValue As String, c As Integer, x As Integer
MyValue = InputBox("Enter value to search for")
Lastrow = Sheets("MyData").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets("New").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("MyData").Activate
x = 0
For i = 1 To Lastrow
       For c = 1 To 6
            If InStr(1, Cells(i, c).Value, MyValue, 1) Then
                Rows(i).Copy Destination:=Sheets("New").Rows(Lastrowa)
                Rows(i).Cells.Interior.ColorIndex = 6
                Lastrowa = Lastrowa + 1
                x = x + 1
            End If
            If x = 1 Then Exit For
        Next c
    Next i
Application.ScreenUpdating = True
End Sub

 

[suzinger]

Thank you for the tip. I will. I apologize.

 

[Michael M]

No need for apologies, it just makes the code easier to read AND debug.
Did you try the latest code ??