Excel / VBA iterate over every cell in a worksheet, compare the value, copy row to another worksheet

Question

In my Excel-File I want to implement a custom search. Therefore I created a worksheet called "Search" - On this Table I put a TextBox, a Button and a short Info-text. At the moment I go over every worksheet and copy the second row (Titles of my columns), then I compare the text of every cell with the searchword and if i get a match I will copy the row, where I found the match.

Private Sub SearchButton_Click()
Application.DisplayAlerts = False       

Dim searchword As String
searchword = Worksheets("Search").SearchTextBox.Text       

If Len(Trim(searchword)) > 0 Then       

    Worksheets("Search").Cells.Delete    

    Dim i As Long
    i = 5                       
    Dim found As Boolean

     For Each Worksheet In ActiveWorkbook.Worksheets       
        Worksheet.Range("A2").EntireRow.Copy Worksheets("Search").Cells(i, 1)    
        i = i + 1           
        found = False   
        For Each cell In Worksheet.UsedRange.Cells      
            If InStr(cell.Text, searchword) > 0 Then     
                cell.EntireRow.Copy Worksheets("Search").Cells(i, 1)    
                found = True     
                i = i + 1                       
            End If
        Next
        If found = True Then
            i = i + 4               
        Else
            Worksheets("Search").Rows(i - 1).Delete   
        End If
     Next

Else
    MsgBox "Empty TextBox!", vbOKOnly, "Error"      
End If

    Application.DisplayAlerts = True            
End Sub

But when a word is multiple times in one row this code will copy this row multiple times. How can I jump to the next row if I find a match?

I'm glad for any help or idea

Answer 1

The answer below will:

1. Search all the sheets in the WorkBook which the code is placed, except the Sheet("Search").
2. In each of those Sheets it will run through every Row and look for the searchword. If it finds the word in that row it will copy the entire row into the Sheet("Search"). It will then move onto the next row of that Sheet.

See Code below:

Option Explicit

Private Sub SearchButton_Click()

    'Application.DisplayAlerts = False

    Dim CurrentSheet As Worksheet
    Dim LastRow As Long
    Dim CurrentRow As Long
    Dim LastColumn As Long
    Dim searchword As String
    Dim TextFoundRng As Range

    searchword = Worksheets("Search").SearchTextBox.Text

    If Len(Trim(searchword)) > 0 Then

        Worksheets("Search").Cells.Delete

        Dim i As Long
        i = 5
        Dim found As Boolean

        'Using this WorkBook instead of Active, incase another workbook is activated
        For Each CurrentSheet In ThisWorkbook.Worksheets

            If CurrentSheet.Name = "Search" Then

            Else

                With CurrentSheet
                    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
                    LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
                End With


                'i = i + 1
                'found = False

                For CurrentRow = 2 To LastRow

                    Set TextFoundRng = CurrentSheet.Range(CurrentSheet.Cells(CurrentRow, 2), _
                                                          CurrentSheet.Cells(CurrentRow, LastColumn)).Find(What:=searchword)
                    'When TextFoundRng <> nothing, it means found something'
                    If Not TextFoundRng Is Nothing Then

                        CurrentSheet.Rows(CurrentRow).EntireRow.Copy Destination:=ThisWorkbook.Sheets("Search").Range("A" & Rows.Count).End(xlUp).Offset(1)

                    End If

                Next CurrentRow

                'For Each cell In CurrentSheet.UsedRange.Cells
                '
                '    If InStr(cell.Text, searchword) > 0 Then
                '        cell.EntireRow.Copy CurrentSheet("Search").Cells(i, 1)
                '        found = True
                '        i = i + 1
                '    End If
                '
                'Next
                'If found = True Then
                '    i = i + 4
                'Else
                '    Worksheets("Search").Rows(i - 1).Delete
                'End If

            End If
        Next CurrentSheet

    Else
        MsgBox "Empty TextBox!", vbOKOnly, "Error"
    End If

    'Application.DisplayAlerts = True
End Sub

I have kept your Found and i code in case you need it for something else, but this code does not need to use it to copy every row which has the searchword from every sheet.

Answer 2

You could do it like this:

Private Sub SearchButton_Click()
    Application.DisplayAlerts = False

    Dim searchword As String
    searchword = Worksheets("Search").SearchTextBox.Text

    If Len(Trim(searchword)) > 0 Then

        Worksheets("Search").Cells.Delete

        Dim i As Long
        i = 5
        Dim found As Boolean

        For Each Worksheet In ActiveWorkbook.Worksheets
            Worksheet.Range("A2").EntireRow.Copy Worksheets("Search").Cells(i, 1)
            i = i + 1
            found = False
            For Each Row In Worksheet.UsedRange.Rows
                For Each cell In Row.Cells
                    If InStr(cell.Text, searchword) > 0 Then
                        cell.EntireRow.Copy Worksheets("Search").Cells(i, 1)
                        found = True
                        i = i + 1
                        Exit For
                    End If
                Next
            Next
            If found = True Then
                i = i + 4
            Else
                Worksheets("Search").Rows(i - 1).Delete
            End If
        Next

    Else
        MsgBox "Empty TextBox!", vbOKOnly, "Error"
    End If
End Sub

Note that this code also searches your Search worksheet, you may want to omit that sheet form the search.