Loading
Ozgrid Excel Help & Best Practices Forums

Excel Training / Excel Dashboards Reports



Results 1 to 7 of 7

Thread: Macro To Search Entire Workbook

  1. #1
    Join Date
    25th February 2007
    Posts
    4

    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 at 13:08.

    Excel Video Tutorials / Excel Dashboards Reports


  2. #2
    Join Date
    25th February 2007
    Posts
    4

    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

    Excel Video Tutorials / Excel Dashboards Reports


  3. #3
    Join Date
    26th January 2003
    Location
    Derbyshire,UK
    Posts
    19,293

    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 at 17:24.
    Hope that Helps

    Roy

    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.

  4. #4
    Join Date
    25th February 2007
    Posts
    4

    Re: Macro To Search Entire Workbook

    Quote 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 at 18:00.

    Excel Video Tutorials / Excel Dashboards Reports


  5. #5
    Join Date
    26th January 2003
    Location
    Derbyshire,UK
    Posts
    19,293

    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. REMINDER! OzGrid accepts no responsibility for ANY adverse effects as a result from downloading attached files. ALWAYS run an up-to-date virus scan and disable macros.
    Last edited by royUK; February 25th, 2007 at 18:13.
    Hope that Helps

    Roy

    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.

  6. #6
    Join Date
    25th February 2007
    Posts
    4

    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.

    Excel Video Tutorials / Excel Dashboards Reports


  7. #7
    Join Date
    26th January 2003
    Location
    Derbyshire,UK
    Posts
    19,293

    Re: Macro To Search Entire Workbook

    Quote 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

    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.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Possible Answers

  1. Search Entire Worksheet And Return Row Specific Result
    By AGOLDSTEIN in forum EXCEL HELP
    Replies: 1
    Last Post: July 31st, 2008, 04:14
  2. Search a worksheet for an entire range
    By tbmbob in forum EXCEL HELP
    Replies: 3
    Last Post: August 8th, 2006, 05:38
  3. Replies: 12
    Last Post: December 8th, 2005, 10:38
  4. Format Entire Workbook
    By petehenson in forum EXCEL HELP
    Replies: 1
    Last Post: November 8th, 2005, 17:54
  5. Totalling an entire Workbook
    By Sidivan in forum EXCEL HELP
    Replies: 4
    Last Post: May 26th, 2005, 03:30

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
porno