code to search across all worksheets

paru

New Member
Joined
Apr 28, 2003
Messages
9
Hello -

I retrieved this code from another message board (not sure who the author is, or I would give that person credit) and I need assistance with it.

When a search only finds one occurrence and the user clicks "continue" to keep searching, the code takes the user to the end of the sheets and returns a "not found" message. This makes the user start the search all over again to get to the one occurrence and be smart enough to say "no" when asked if they want to continue or not. Ideally, if there are no other occurrences found, it would keep the single occurrence selected and allow the user to stay at that location, rather than taking the user to the end of the worksheets, thereby losing their search result.

Can anyone assist me with this?

~~~~~~~~~~~~~~~~~~~~~~~~


Sub FindAcrossAll()

Dim DoIt As Boolean

Dim What As String


DoIt = True

While DoIt

What = InputBox("What are you looking for?")

For Each Sht In Worksheets

Sht.Activate

Set Found = Sht.UsedRange.Find(What)

If Not Found Is Nothing Then ' The value has been found.

FirstAddress = Found.Address

Do

Found.Activate

Msg = "Continue the search ?"

Title = "Continue ?"

Response = MsgBox(Msg, vbYesNo + vbQuestion, Title)

If Response = vbNo Then ' Doesn't want to continue

MsgBox "Search cancelled by user."

Found.Activate

Exit Sub ' Quit the macro

End If

Set Found = Cells.FindNext(After:=ActiveCell)

If Found.Address = FirstAddress Then Exit Do

Loop

End If

Next Sht

If Found Is Nothing Then ' Nothing found

Msg = "Not found! Do you want to start a new search?"

Style = vbYesNo + vbCritical + vbDefaultButton2

Else

Msg = "Search complete. Do you want to start a new search?"

Style = vbYesNo + vbDefaultButton2

Found.Activate

End If

Title = "Search Complete"

Response = MsgBox(Msg, Style, Title)

If Response <> vbYes Then DoIt = False

Wend

MsgBox ("Search has ended.")


End Sub
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Welcome to the Board!

This will find each instance of what you want to find and will highlight the item. If you say 'No' when asked to continue, the last item found will be highlighted.
Code:
Sub FindAll()
Dim strReply As String
Dim rngObj As Range
Dim FirstAddress As String
Dim newReply
Dim sht As Worksheet

    strReply = InputBox("What text do you want to find?", "Text Finder")
    If strReply = "" Then Exit Sub
    
    For Each sht In Worksheets
        sht.Activate
        Set rngObj = Cells.Find(What:=strReply, After:=ActiveCell, LookAt:=xlPart, MatchCase:=False)
            If Not rngObj Is Nothing Then
                FirstAddress = rngObj.Address
                   Do
                      rngObj.Activate
                          newReply = MsgBox("Continue with the search?", vbYesNo + vbQuestion)
                             If newReply = vbNo Then Exit Sub
                                Set rngObj = Cells.FindNext(After:=ActiveCell)
                             If rngObj.Address = FirstAddress Then Exit Do
                     Loop
             End If
    Next sht
End Sub
HTH

Regards
 
Upvote 0
Sadly, this is still acting like the original code. When I search for something and excel finds only one occurence, it is ending on the last worksheet without returning to the found item.
Hmmmmmm.....perplexing.
 
Upvote 0
Glaswegian, I have been playing with your code in an attempt to meet Paru's requirements.

Basically I put the FirstAddress to a Range and then put in the last line before the End Sub.

It works OK on the first sheet but I then got a 1004 on the second sheet, I tried to resolve this by Setting FirstAddress to A1 and placing an On error statement in the code, but I have now run out of time to resolve the 1004 properly, so with due acknowledgements to you I will post this to allow someone else to develop the answer for Paru.

It currently selects nothing on Sheet2 - puzzling
Code:
Sub FindAll()
    Dim strReply As String
    Dim rngObj As Range
    Dim FirstAddress As Range
    Dim newReply
    Dim sht As Worksheet

    strReply = InputBox("What text do you want to find?", "Text Finder")
    If strReply = "" Then Exit Sub
    
    For Each sht In Worksheets
        On Error Resume Next
        sht.Activate
        Set FirstAddress = Range("A1")
        Set rngObj = Cells.Find(What:=strReply, After:=ActiveCell, LookAt:=xlPart, MatchCase:=False)
            If Not rngObj Is Nothing Then
                Set FirstAddress = rngObj
                Do
                    rngObj.Activate
                    newReply = MsgBox("Continue with the search?", vbYesNo + vbQuestion)
                    If newReply = vbNo Then Exit Sub
                    Set rngObj = Cells.FindNext(After:=ActiveCell)
                    If rngObj.Address = FirstAddress.Address Then Exit Do
                Loop
            End If
    Next sht
    If rngObj.Address = FirstAddress.Address Then Application.Goto Reference:=FirstAddress
End Sub
Paru, HTH a bit (y)
 
Upvote 0
Just tried it - it still finds the single occurence, then when it cannot locate any more occurences it stops on the last worksheet.

What's really strange is when you use the "edit / find" command from the menu bar and select the option to search "Withing Workbook", it behaves the way I would like. I tried to record a macro that would just launch the edit/find/within workbook for them, but was not successful. That is what got me off on this search for an input box or some other method to accomplish the search.

I know what you're thinking ... "just have the end-user use the canned edit/find option!". However, we are dealing with a wide range of end-users who sometimes struggle with very basic commands. We'd have to do a formal training session for some of these folks to get them to understand how to do that simple task (no joke...some of them are quite challenged).

Nice try, though! :)
 
Upvote 0
Try this solution ...

Sub FindAcrossAll()

Dim What As Variant

Dim LastAddr As String
Dim LastSheet As String
Dim NeverFound As Boolean



NewSearch:
NeverFound = True


What = Application.InputBox("What are you looking for?")
If What = False Then Exit Sub

For Each Sht In Worksheets

Sht.Activate

Set Found = Sht.UsedRange.Find(What)

If Not Found Is Nothing Then ' The value has been found.

FirstAddress = Found.Address

Do

Found.Activate
LastAddr = Found.Address
LastSheet = Sht.Name
NeverFound = False

Msg = "Continue the search ?"

Title = "Continue ?"

Response = MsgBox(Msg, vbYesNo + vbQuestion, Title)

If Response = vbNo Then ' Doesn't want to continue

MsgBox "Search cancelled by user."
Found.Activate
Exit Sub ' Quit the macro

End If

Set Found = Cells.FindNext(After:=ActiveCell)

If Found.Address = FirstAddress Then Exit Do

Loop

End If

Next Sht

If NeverFound Then ' Nothing found
ln1 = "The string " & Chr(34) & What & Chr(34) & " was not found !" & vbCrLf
ln2 = "Do you want to start a new search?"
Msg = ln1 & ln2

Style = vbYesNo + vbCritical + vbDefaultButton2
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then
MsgBox ("Search has ended.")
Exit Sub
Else
GoTo NewSearch
End If

Else

Msg = "Search complete. Do you want to go back to last found ?"
Style = vbYesNo + vbDefaultButton2
Title = "Search Complete"

Response = MsgBox(Msg, Style, Title)

If Response = vbYes Then
Sheets(LastSheet).Select
Range(LastAddr).Select
Exit Sub
Else
Msg = " Do you want to start a new search?"
Title = "What Next ?"
Style = vbYesNo + vbQuestion + vbDefaultButton2
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then
MsgBox ("Search has ended.")
Exit Sub
Else
GoTo NewSearch
End If

End If

End If

End Sub
 
Upvote 0

Forum statistics

Threads
1,214,834
Messages
6,121,876
Members
449,056
Latest member
ruhulaminappu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top