简体   繁体   中英

Search tool in excel, vba

I'm novice in excel VBA and I really need help to extend my code. The code searches for a text in all work sheets. I would like to list all the search results in the first sheet with the complete row where the text is found. Unfortunately I don't know how to copy the row where the criteria is found. Maybe if I can get a solution to inspect the code would be a great help.

Sub SearchAllSheets()

Dim ws As Worksheet
Dim rFound As Range
Dim strName As String

    On Error Resume Next
    strName = InputBox("What are you looking for?")
    If strName = "" Then Exit Sub
    For Each ws In Worksheets
        With ws.UsedRange
            Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
            If Not rFound Is Nothing Then
                Application.Goto rFound, True
                Exit Sub
            End If
        End With
    Next ws
    On Error GoTo 0

    MsgBox "Value not found"

End Sub

Below code will paste the row with data found to sheet Output . Code will not search Output sheet for result.

Sub SearchAllSheets()        
    Dim ws As Worksheet, OutputWs As Worksheet
    Dim rFound As Range
    Dim strName As String
    Dim count As Long, LastRow As Long
    Dim IsValueFound As Boolean        

    IsValueFound = False
    Set OutputWs = Worksheets("Output")    '---->change the sheet name as required
    LastRow = OutputWs.Cells(Rows.count, "A").End(xlUp).Row

    On Error Resume Next
    strName = InputBox("What are you looking for?")
    If strName = "" Then Exit Sub
    For Each ws In Worksheets
        If ws.Name <> "Output" Then
            With ws.UsedRange
                Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
                If Not rFound Is Nothing Then
                    Application.Goto rFound, True
                    IsValueFound = True
                    'MsgBox rFound.Row
                    rFound.EntireRow.Copy
                    OutputWs.Cells(LastRow + 1, 1).PasteSpecial xlPasteAll
                    Application.CutCopyMode = False
                    LastRow = LastRow + 1
                End If
            End With
        End If
    Next ws
    On Error GoTo 0
    If IsValueFound Then
       OutputWs.Select
       MsgBox "Result pasted to Sheet Output"
    Else
        MsgBox "Value not found"
    End If
End Sub

I guess you are looking to search a text for all the occurrences in all the sheets. Try this code:

Sub SearchAllSheets()
    Dim ws As Worksheet, OutputWs As Worksheet
    Dim rFound As Range, FirstAddress
    Dim strName As String
    Dim count As Long, LastRow As Long
    Dim IsValueFound As Boolean

    IsValueFound = False
    Set OutputWs = Worksheets("Output")    '---->change the sheet name as required
    LastRow = OutputWs.Cells(Rows.count, "A").End(xlUp).Row

    On Error Resume Next
    strName = InputBox("What are you looking for?")
    If strName = "" Then Exit Sub
    For Each ws In Worksheets
        If ws.Name <> "Output" Then
            With ws.UsedRange
                Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
                If Not rFound Is Nothing Then
                    FirstAddress = rFound.Address

                    Do
                        Application.Goto rFound, True
                        IsValueFound = True
                        'MsgBox rFound.Row
                        Debug.Print rFound.Address

                        rFound.EntireRow.Copy
                        OutputWs.Cells(LastRow + 1, 1).PasteSpecial xlPasteAll
                        Application.CutCopyMode = False
                        LastRow = LastRow + 1

                        Set rFound = .FindNext(rFound)
                    Loop While Not rFound Is Nothing And rFound.Address <> FirstAddress

                End If
            End With
        End If
    Next ws
    On Error GoTo 0
    If IsValueFound Then
       OutputWs.Select
       MsgBox "Result pasted to Sheet Output"
    Else
        MsgBox "Value not found"
    End If
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM