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.