Announcement

Collapse
No announcement yet.

Macro To Search Entire Workbook

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Macro To Search Entire Workbook

    i have a workbook that contains a series of worksheets. the workbook is a master document list. the first worksheet contains no data. the remaining worksheets are arranged so that A1 has the document number, A2 contains the document title, and A3 contains the review date.

    Id like to create a search macro that can search for the string entered into textbox1. if this is a number, the macro should search A1:A50 of all but the first worksheets in the workbook, and if its text, the macro should search B1:B50 of all but the first worksheets.

    the macro should then select the cell containing what was searched.

    then id like the macro to prompt me and ask if id like to modify the reviewed date to todays date.

    id like to be prompted to continue searching for other records if they exist, and after that loop has finished to set the focus back to the search textbox.

    hopefully that makes sense. i tried to be specific and to the point, which is why it might sound cold.

    thanks
    Last edited by stevearama; February 25th, 2007, 13:08.

  • #2
    Re: Macro To Search Entire Workbook

    Sorry. that was probably too many questions at once. here is the code that I have. it seems to work well at searching over the whole workbook. i havent attempted to get the macro to prompt me to change the review date to todays date. im trying.

    Code:
    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:="What are you 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.CurrentRegion.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, "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
                 '//dont look further
                If Reply = vbYes Then
                    Set SelectedRegion = Selection
    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
    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.CurrentRegion.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

    Comment


    • #3
      Re: Macro To Search Entire Workbook

      Just had a preliminary look at your code. You seem to locate the search item with Find, which is Ok. Then colour the cells CurrentRegion yellow. Why do you search again for the item since you already have it's address, or are you looking for multiple instances in the same sheet?
      Last edited by royUK; February 25th, 2007, 17:24.
      Hope that Helps

      Roy

      New users should read the Forum Rules before posting

      For free Excel tools & articles visit my web site

      If I have helped you and you feel like putting your hand in your pocket please make a donation to Children in Need

      RoyUK's Web Site

      royUK's Database Form

      Where to paste code from the Forum

      About me.

      Comment


      • #4
        Re: Macro To Search Entire Workbook

        Originally posted by royUK
        Just had a preliminary look at your code. You seem to locate the search item with Find, which is Ok. Then colour the cells CurrentRegion yellow. Why do you search again for the item since you already have it's address, or are you looking for multiple instances in the same sheet?

        Yes exactly. it searches, and when it finds what its searching for, it selects the cell, changes its colour, and then displays a message box asking if that is the one you want. if you say yes, it selects the cell, if you say no it continues searching.

        its done that way so that i can search using key words - and cycle through all of the matching cells.

        the search part of the code seems to work quite well. ive made a few changes from the code above to ensure it will select single cells only. What im struggling with now is adding the second part of my desired code..

        id like the macro to prompt me and ask if id like to modify the reviewed date to todays date. but ive actually changed my mind slightly. ive added a check box next to the command button that runs the search code. if the checkbox is selected, then id like the searched for result to update the date in cell A3.

        would it be useful for me to attach a .xls?

        thanks for replying...
        Last edited by stevearama; February 25th, 2007, 18:00.

        Comment


        • #5
          Re: Macro To Search Entire Workbook

          I think this does what you want. A userform with a TextBox to enter he search string, a commandbutton to search spific regions of all sheets containing data, optional extra another button to search only the active sheet. A button to close the form.

          Edit: i finished this bfore seeing your reply. You should be able to amend the code if you want.

          Code:
          '---------------------------------------------------------------------------------------
          ' Module    : frmSearch_Sheets
          ' DateTime  : 25/02/2007 08:59
          ' Author    : Roy Cox (royUK)
          ' Website   :  more examples
          ' Purpose   : UserForm to search all sheets for a value
          ' Disclaimer; This code is offered as is with no guarantees. You may use it in your
          '             projects but please leave this header intact.
          '---------------------------------------------------------------------------------------
          Option Explicit
          Dim oWs        As Worksheet
          Dim rSearch    As Range
          Dim rCl        As Range
          Dim sFind      As String
          Dim sFirstAddress As String
          
          Private Sub cmdFinish_Click()
              Unload Me
          End Sub
          
          Private Sub cmdSearch_Acive_Click()
              If Me.tbxFind.Value = "" Then
                  MsgBox "No search item entered"
                  Me.tbxFind.SetFocus
                  Exit Sub
              Else: sFind = Me.tbxFind.Value
              End If
          
              If IsNumeric(sFind) Then
                  Set rSearch = oWs.Range("a1:a50")
              Else: Set rSearch = oWs.Range("b1:b50")
              End If
              'find it
              With rSearch
                  Set rCl = .Find(sFind, LookIn:=xlValues)
                  If Not rCl Is Nothing Then
                      Select Case MsgBox(sFind & " here: " & oWs.Name & " : " & _
                                         rCl.Address & ". Do you want to modify the data?", vbYesNo Or _
                                                                                            vbQuestion Or vbDefaultButton1, "Success")
          
                          Case vbYes
                              rCl.Select
                              End
                          Case vbNo
                              'continue search of sheet
                              sFirstAddress = rCl.Address
                              Do
                                  'colour cell if you want
                                  rCl.Interior.ColorIndex = 3
                                  Set rCl = .FindNext(rCl)
                              Loop While Not rCl Is Nothing And rCl.Address <> sFirstAddress
          
                      End Select
                  End If
              End With
          
          End Sub
          
          Private Sub cmdSearch_All_Click()
          
              If Me.tbxFind.Value = "" Then
                  MsgBox "No search item entered"
                  Me.tbxFind.SetFocus
                  Exit Sub
              Else: sFind = Me.tbxFind.Value
              End If
          
              For Each oWs In ActiveWorkbook.Worksheets
                  'check for entries in sheets
                  If Application.WorksheetFunction.CountA(oWs.Cells) > 0 Then
                      'determine range to search
                      If IsNumeric(sFind) Then
                          Set rSearch = oWs.Range("a1:a50")
                      Else: Set rSearch = oWs.Range("b1:b50")
                      End If
                      'find it
                      With rSearch
                          Set rCl = .Find(sFind, LookIn:=xlValues)
                          If Not rCl Is Nothing Then
                              Select Case MsgBox(sFind & " here: " & oWs.Name & " : " & _
                                                 rCl.Address & ". Do you want to modify the data?", vbYesNo _
                                                                                                    Or vbQuestion Or vbDefaultButton1, "Success")
          
                                  Case vbYes
                                      rCl.Select
                                      End
                                  Case vbNo
                                      'continue search of sheet
                                      sFirstAddress = rCl.Address
                                      Do
                                          'colour cell if you want
                                          rCl.Interior.ColorIndex = 3
                                          Set rCl = .FindNext(rCl)
                                      Loop While Not rCl Is Nothing And rCl.Address <> sFirstAddress
          
                              End Select
                          End If
                      End With
                  End If
              Next oWs
          End Sub

          I am attaching the form, you can extract it & import i into your project if you want
          Attached Files
          Last edited by royUK; February 25th, 2007, 18:13.
          Hope that Helps

          Roy

          New users should read the Forum Rules before posting

          For free Excel tools & articles visit my web site

          If I have helped you and you feel like putting your hand in your pocket please make a donation to Children in Need

          RoyUK's Web Site

          royUK's Database Form

          Where to paste code from the Forum

          About me.

          Comment


          • #6
            Re: Macro To Search Entire Workbook

            Roy your code is very good! thanks for your efforts. im far better at modifying other peoples code than i am at actually creating my own. so ill happily tinker with yours.

            Comment


            • #7
              Re: Macro To Search Entire Workbook

              Originally posted by stevearama
              Roy your code is very good! thanks for your efforts. im far better at modifying other peoples code than i am at actually creating my own. so ill happily tinker with yours.
              I think I've marked where to change things, but get back if you need help
              Hope that Helps

              Roy

              New users should read the Forum Rules before posting

              For free Excel tools & articles visit my web site

              If I have helped you and you feel like putting your hand in your pocket please make a donation to Children in Need

              RoyUK's Web Site

              royUK's Database Form

              Where to paste code from the Forum

              About me.

              Comment

              Working...
              X