Search entire workbook with control button

Hi all,

Was just wondering if it is possible to search an entire workbook for data which a user has input in say cell A1 on Sheet 1 (or a textbox), and then have them click on a 'search' button located next to the cell to find the data and take them to the cell where it's located? This sounds easy I know but I've spent all day trying to figure out how to do it and not having a great deal of experience with macros am having a bit of trouble!

Hopefully it's clear what I'm after but I'll reiterate:

- Data input by user in cell A1 (or textbox whichever is easier!)
- 'Search' button clicked after data entered
- User is taken to worksheet where that data is located and cell is highlighted

Any and all help very much appreciated.

Lock-e73 ;Þ

hi try this

Sub CommandButton1_Click()
     
    Dim ThisAddress$, Found, FirstAddress
    Dim Lost$, N&, NextSheet&
    Dim CurrentArea As Range, SelectedRegion As Range
    Dim Reply As VbMsgBoxResult
    Dim FirstSheet As Worksheet
    Dim Ws As Worksheet
    Dim Wks As Worksheet
    Dim Sht As Worksheet
     
    Set FirstSheet = ActiveSheet '< bookmark start sheet
    Lost = InputBox(prompt:="Type in the   book details you are looking for!", _
    Title:=" Find what?", Default:="*")
    If Lost = Empty Then End
    For Each Ws In Worksheets
        Ws.Select
        With ActiveSheet.Cells
            Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues)
            If FirstAddress Is Nothing Then '< blank sheet
                GoTo NextSheet
            End If
            FirstAddress.Select
             '    Selection.Interior.ColorIndex = 6 '< yellow
             '//colour the 'Lost' font red, cell colour blank
            With Selection
                Set Found = .Find(What:=Lost, LookIn:=xlValues)
                If Not Found Is Nothing Then
                    FirstAddress = Found.Address
                  '  Do
                         '     Found.Interior.ColorIndex = 3 '< red
                         '    Found.Font.Bold = True
                         '   Found.Font.ColorIndex = 2
                         '   Set Found = .FindNext(Found)
                  '   Loop While Not Found Is Nothing And Found. _
                    Address <> FirstAddress
                End If
            End With
            Reply = MsgBox("Is this the " & Lost & " you're looking for?", _
            vbQuestion + vbYesNoCancel)
             '//restore the 'Lost' font and cell colour
            Set Found = .Find(What:=Lost, LookIn:=xlValues)
            If Not Found Is Nothing Then
                FirstAddress = Found.Address
                Do
                     ' Found.Font.Bold = False
                     'Found.Font.ColorIndex = 0
                    Set Found = .FindNext(Found)
                Loop While Not Found Is Nothing And Found. _
                Address <> FirstAddress
            End If
             '//restore the selection colour
             '  Selection.Interior.ColorIndex = xlNone
            Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues)
            If Reply = vbCancel Then End
             '//dont look further
            If Reply = vbYes Then
                Set SelectedRegion = Selection
                 ActiveCell.Interior.ColorIndex = 3
                
GoTo Finish:
            End If
             '//   case=not this one
            ThisAddress = FirstAddress.Address
            Set CurrentArea = Selection
            Do
                If Intersect(CurrentArea, Selection) Is Nothing Then
                     ''  With Selection.Interior
                     '    .ColorIndex = 6
                     '   .Pattern = xlSolid
                     '   End With
                     '//colour the 'Lost' font red, cell colour blank
                    With Selection
                        Set Found = .Find(What:=Lost, LookIn:=xlValues)
                        If Not Found Is Nothing Then
                            FirstAddress = Found.Address
                            Do
                                 '  Found.Interior.ColorIndex = 3
                                 ' Found.Font.Bold = True
                                 'Found.Font.ColorIndex = 2
                                Set Found = .FindNext(Found)
                            Loop While Not Found Is Nothing And Found. _
                            Address <> FirstAddress
                        End If
                    End With
                    Reply = MsgBox("Is this the " & Lost & " you're looking for?", _
                    vbQuestion + vbYesNoCancel, "Current Region")
                     '//restore the 'Lost' font and cell colour
                    Set Found = .Find(What:=Lost, LookIn:=xlValues)
                    If Not Found Is Nothing Then
                        FirstAddress = Found.Address
                       ' Do
                             ' Found.Font.Bold = False
                             ' Found.Font.ColorIndex = 0
                            Set Found = .FindNext(Found)
                     '   Loop While Not Found Is Nothing And Found. _
                        Address <> FirstAddress
                    End If
                     '//restore the selection colour
                     '  Selection.Interior.ColorIndex = xlNone
                    Set FirstAddress = .Find(What:=Lost, _
                    LookIn:=xlValues)
                    If Reply = vbCancel Then End
                    If Reply = vbYes Then
                      '  Set SelectedRegion = Selection
                    ActiveCell.Interior.ColorIndex = 3
                        ' Found.Interior.ColorIndex = 3
                                  Found.Font.Bold = True
                                 Found.Font.ColorIndex = 2
                        
GoTo Finish:
                    End If
                End If
                If CurrentArea Is Nothing Then
                    Set CurrentArea = Selection
                Else
                    Set CurrentArea = Union(CurrentArea, Selection)
                End If
                Set FirstAddress = .FindNext(FirstAddress)
                FirstAddress.Select
            Loop While Not FirstAddress Is Nothing And FirstAddress. _
            Address <> ThisAddress
        End With
NextSheet:
    Next Ws
Finish:
    If Reply = vbYes Then
        Exit Sub
    Else
        FirstSheet.Select
        MsgBox "Search Completed - Sorry, no more " & Lost & "s", _
        vbInformation, "No Region Selected"
    End If
End Sub

steve

Thanks heaps Steve,

I think that will do it nicely. Did you just have that little bit of code hangin' about? If so it's mighty handy

Thanks again ... lock-e73

glad it helped

it help me when i asked the same question some time ago. but i forgot who gave it to me.

steve