Data search / filter all worksheets

[airpix]

Does anyone know if it's possible to search / filter more than 1 worksheet at a time? I have a workbook that contains 12 worksheets and if I looking for say, a clients name in all the worksheets right now the only way I can find / filter that clients name is by filtering each worksheet.

Thanks, Airpix

[stevekirk]

hi,

this code will ask you for the name you want to search on then stop at every occurance of that name

Sub searchname_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
            
            With Selection
                Set Found = .Find(What:=Lost, LookIn:=xlValues)
                If Not Found Is Nothing Then
                    FirstAddress = Found.Address
                  
                End If
            End With
            Selection.Copy
          
           
            
            
           Reply = MsgBox("Is this the " & Lost & " you're looking for?", _
            vbQuestion + vbYesNoCancel)
            
           Set Found = .Find(What:=Lost, LookIn:=xlValues)
            If Not Found Is Nothing Then
               FirstAddress = Found.Address
                Do
                     
                    Set Found = .FindNext(Found)
                Loop While Not Found Is Nothing And Found. _
                Address <> FirstAddress
            End If
             
            Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues)
            If Reply = vbCancel Then End
             
           If Reply = vbYes Then
               Set SelectedRegion = Selection
               
                
GoTo Finish:
            End If
             
            ThisAddress = FirstAddress.Address
            Set CurrentArea = Selection
            Do
                If Intersect(CurrentArea, Selection) Is Nothing Then
                   
                   
                    With Selection
                        Set Found = .Find(What:=Lost, LookIn:=xlValues)
                        If Not Found Is Nothing Then
                            FirstAddress = Found.Address
                            Do
                                
                                Set Found = .FindNext(Found)
                            Loop While Not Found Is Nothing And Found. _
                            Address <> FirstAddress
                        End If
                    End With
                    Selection.Copy
                
        ' Range("h1").Select
         '  ActiveSheet.Paste
           
                    
                    
                   Reply = MsgBox("Is this the " & Lost & " you're looking for?", _
                    vbQuestion + vbYesNoCancel, "Current Region")
                     
                    Set Found = .Find(What:=Lost, LookIn:=xlValues)
                    If Not Found Is Nothing Then
                        FirstAddress = Found.Address
                       
                            Set Found = .FindNext(Found)
                    
                    End If
                     
                    Set FirstAddress = .Find(What:=Lost, _
                    LookIn:=xlValues)
                    If Reply = vbCancel Then End
                    If Reply = vbYes Then
                      
                      
                      
                      
                      
                                           
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

[broro183]

hi

Does anyone know if it's possible to search / filter more than 1 worksheet at a time? I have a workbook that contains 12 worksheets and if I looking for say, a clients name in all the worksheets right now the only way I can find / filter that clients name is by filtering each worksheet.

Thanks, Airpix

There's quite a difference in the literal Excel meaning between "search" & "filter". Steve's gone for the search approach via a macro & my below macro approach focuses on the use of the autofilter tool. However, it is possible that you don't need either of these approaches...?

Try pressing [ctrl + F], typing in the client name, clicking Options to expand the dialogbox, change "Within" from sheet to Workbook & "lookin" to values, and then clicking Find All.
In my version of Excel (2003) this brings up a hyperlinked list of all the cells (+ the sheet it is on etc) within the workbook that contain (or equal, depending on what option you ticked) your search value. The Find box can then be resized as needed to show some of the current sheet as well as what is in the dialog box.
Is this all you need?

Or you may like Tushtar's FindAll function:
http://www.tushar-mehta.com/excel/tips/findall.html

If not, the below is a possible macro which will filter a set column (the same for every sheet) for a user specified value or if the input is left blank it will filter the same column of every sheet for the value of the active cell.
Note: this currently relies on every sheet having an autofilter (ie dropdown arrows, but not necessarily with anything filtered). It was going to be a simpler macro but I got carried away (as you may see by the size & the slightly random swapping between If Statements & Select Case statements)!

Option Explicit
Dim CancelSearch As Boolean

Sub FilterMultipleSheets()
   
Dim Ws As Worksheet
Dim ClientName As String
Dim ColumnToFilterOnEachSheet As String
Dim VisibleRng As Range
Dim SheetsWithClientName As String
Dim NumOfSheets As Long

'to set a default value
CancelSearch = False

'grab user input - it may be better to use the Input Method rather than this Input function, I'm not sure...?
ClientName = InputBox(prompt:="Please type in the Client Name " & Chr(13) & "or leave the cell empty to use " _
& "the value of the active cell as the client name" & Chr(13) & "or type in 'clearallfilters'", _
Title:="THE CLIENT NAME IS...?")

'To end sub if "cancel" was pressed sourced from _
http://www.excelforum.com/showthread.php?t=466059&highlight=vbcancel+input & http://vb.mvps.org/tips/varptr.asp
If StrPtr(ClientName) = 0 Then MsgBox "Search cancelled": Exit Sub

'apply/remove filters
Select Case ClientName
    Case Is <> "clearallfilters"
        'identify what filtering is needed
        Select Case Len(ClientName)
            Case 0
                If Len(ActiveCell.Value) = 0 Then
                    MsgBox "no value supplied so Search cancelled": Exit Sub
                Else
                    With ActiveCell
                        ClientName = .Value
                        ColumnToFilterOnEachSheet = .Column
                    End With
                End If
            Case Else
                ColumnToFilterOnEachSheet = DefinedColumnToFilterOnEachSheet()
                If CancelSearch Then MsgBox "No column entered therefore macro ending": Exit Sub
        End Select
        'apply the filters
        For Each Ws In ActiveWorkbook.Worksheets
            With Ws
            'Some very rough error checking is added here just in case not every sheet has an autofilter...
                If .AutoFilterMode = False Then .UsedRange.AutoFilter
                    On Error Resume Next
                        .ShowAllData ' this removes any active filtering before applying the new filters
                    On Error GoTo 0
                    With .Range("_filterdatabase")
                        .AutoFilter Field:=ColumnToFilterOnEachSheet, Criteria1:=ClientName
        
                        'you could create a list of the sheet names that have visible cells when filtered for the _
                        ClientName by using...
                        On Error Resume Next
                            Set VisibleRng = .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
                        On Error GoTo 0
                    End With
                    If VisibleRng Is Nothing Then
                        'do nothing because there are no visible cells
                    Else
                        SheetsWithClientName = SheetsWithClientName & .Name & ", "
                        NumOfSheets = NumOfSheets + 1
                        'reset the range & free memory
                        Set VisibleRng = Nothing
                    End If
            End With
        Next Ws
        MsgBox "The Client Name, " & ClientName & ", was found on the following " & NumOfSheets & " sheets:" _
            & Chr(13) & Left(SheetsWithClientName, Len(SheetsWithClientName) - 2) 'this code by tidier but it works

    Case "clearallfilters" ' a magic phrase to reset each page
        For Each Ws In ActiveWorkbook.Worksheets
            With Ws
                'Some very rough error checking is added here just in case not every sheet has an autofilter...
                If .AutoFilterMode = False Then .UsedRange.AutoFilter
                .ShowAllData
            End With
        Next Ws
        MsgBox "All filters cleared"
End Select
End Sub

Private Function DefinedColumnToFilterOnEachSheet()
Dim LetterCheck As Long 'this should probably be declared differently???

start:
DefinedColumnToFilterOnEachSheet = InputBox(prompt:="Please type in the number or the letter " & _
        "of the column to filter.", Title:="THE COLUMN TO FILTER IS...?")

'To end sub if "cancel" was pressed sourced from _
http://www.excelforum.com/showthread.php?t=466059&highlight=vbcancel+input & http://vb.mvps.org/tips/varptr.asp
If StrPtr(DefinedColumnToFilterOnEachSheet) = 0 Then MsgBox "Search cancelled b/c no column entered": _
    CancelSearch = True: Exit Function

'converts a letter to a number
'sourced from http://www.programmersheaven.com/mb/VBasic/26189/26189/ReadMessage.aspx
LetterCheck = Asc(UCase(DefinedColumnToFilterOnEachSheet)) - 64

Select Case True
    Case LetterCheck > 0 And LetterCheck < 27
    'converts a letter to a number
        DefinedColumnToFilterOnEachSheet = LetterCheck
    Case IsNumeric(DefinedColumnToFilterOnEachSheet)
    'does nothing b/c the input is usable "as is". If a decimal is entered this will result in an error later
    Case Else
    'creates a loop forcing a valid input unless cancel is pressed
        GoTo start
End Select
End Function

hth
Rob

[airpix]

Thanks Steve & Rob, I think this will do the trick.

Airpix

[airpix]

This works great for finding all entries of a specific client. Now that I have that info, shown in the find box, is there some way to copy all the entries and maybe paste into a new worksheet so I can total the columns?

Thanks, Airpix



"Try pressing [ctrl + F], typing in the client name, clicking Options to expand the dialogbox, change "Within" from sheet to Workbook & "lookin" to values, and then clicking Find All.
Is this all you need"

[broro183]

hi Airpix,

Sorry for the delay in responding - I hope you have a bit of time to read this novel...!

This works great for finding all entries of a specific client. Now that I have that info, shown in the find box, is there some way to copy all the entries and maybe paste into a new worksheet so I can total the columns?

It would seem that if you are able to take data from each sheet & paste it into a new one for subtotaling etc that our macros may be complete overkill. I don't know the layout of your workbook but I'm curious, why do you have separate sheets?
Is there too much data for a single sheet?
I suggest that you copy all the data onto a single sheet so it becomes a "database" with one set of headers. If there is a specific reason why they were on different sheets this could be listed in a new column to the right of the data. Once you have a "database' you could:
a) create a Pivot table on a separate sheet & use this for subtotals etc. Check out Debra's Pivot Table pages listed on her index page http://www.contextures.com/tiptech.html
starting with http://www.contextures.com/xlPivot01.html

b) Apply an autofilter to your database, insert a couple of blank rows at the top and put subtotals at the top of each of the required columns (this means that they stay visible when filters are applied). Filter the client column for the required client & print out the sheet or paste the visible cells to a new sheet if needed.

****
I think Steve's macro is quite close to being able to copy the info into a new sheet for you but he'll probably be able to modify it quicker than I can.
Instead I've made a macro that uses Tushar's function, if you copy his function into a module & then copy the below macro as well you should be able to use the below macro:

Sub FindAndCopyClientInfoToTempSheet()
'Objective: Use Tushar's Findall function* to loop through all sheets in the active workbook searching for a Client _
& then copying the data to a new sheet.
'*sourced from http://www.tushar-mehta.com/excel/tips/findall.html

Dim Ws As Worksheet
Dim TempSht As Worksheet
Dim CellOnFirstEmptyRow As Range
Dim ClientName As String

'grab user input - it may be better to use the Input Method rather than this Input function, I'm not sure...?
ClientName = InputBox(prompt:="Please type in the Client Name " & Chr(13) & "or leave the cell empty to use " _
& "the value of the active cell as the client name" & Chr(13) & "or type in 'clearallfilters'", _
Title:="THE CLIENT NAME IS...?")

'To end sub if "cancel" was pressed sourced from _
http://www.excelforum.com/showthread.php?t=466059&highlight=vbcancel+input & http://vb.mvps.org/tips/varptr.asp
If StrPtr(ClientName) = 0 Then MsgBox "Search cancelled": Exit Sub

'insert a temp sheet for pasting the results into
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Temp Sheet Summarising " & ClientName
Set TempSht = ActiveSheet
    
    For Each Ws In ActiveWorkbook.Worksheets
        'this assumes that there will always be a value in column A, if this is not true let me know...
        Set CellOnFirstEmptyRow = TempSht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        If Ws = TempSht Then GoTo SkipSht 'prevents the whole summary being duplicated
        'the below copies the whole row for each instance where the client name is found. If you want to _
        limit the columns copied let me know...
        FindAll(ClientName, Ws, xlValues, xlWhole).EntireRow.Copy CellOnFirstEmptyRow
SkipSht:
    Next Ws

'edit: to free memory
set TempSht = nothing
set CellOnFirstEmptyRow = nothing

End Sub

****

Steve,
Your code seems to have potential but Tushar's is pretty darn polished so hopefully the above helps the op.
*One technique I've seen for shortening code is to identify any repeated steps, split them into a separate macro/function (whichever's more appropriate) & then call it from the main macro. I think you could probably do this with some of the repetitions of the below code:

Set Found = .Find(What:=Lost, LookIn:=xlValues)
                If Not Found Is Nothing Then
                    FirstAddress = Found.Address
                End If

*The below one confuses me a little, doesn't the first line of code mean that there will always be an Intersection between the two ranges (if there is a selection to start with)?

Set CurrentArea = Selection
            Do
                If Intersect(CurrentArea, Selection) Is Nothing Then '...

*****


hth
Rob

[Bill Rudd]

I am trying for something similar to the first author. I would like to search multiple worksheets for a string input by the user, then copy the row associated with any found cell to a new worksheet.

Steve's program above is working very well for me. When I try to splice a piece of code though from another code that was successfully copying a row (with a determined variable present) to a new sheet, I am getting a syntax error of some sort.

I've added the copy-paste portion of code where I thought it should go, about 3/4 through Steve's code, without effecting any part of the program success until I choose 'yes, the one I'm looking for', then a "Run-time error '13' Type Mismatch".

This is the code where I'm at. Have you gentle-persons got a bit more insight for me? The spliced code is blue, the error line is red.

(If a scratch answer is easier than fixing my error, then my objective is to have a search box come up, any row corresponding on any worksheet to the input variable copied to the last worksheet. Actually, a drop-down box to select a variable would be even better than a search box.).

Yours Truly,
Bill Rudd

Sub SearchForString()

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

With Selection
Set Found = .Find(What:=Lost, LookIn:=xlValues)
If Not Found Is Nothing Then
FirstAddress = Found.Address

End If
End With
Selection.Copy




Reply = MsgBox("Is this the " & Lost & " you're looking for?", _
vbQuestion + vbYesNoCancel)

Set Found = .Find(What:=Lost, LookIn:=xlValues)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do

Set Found = .FindNext(Found)
Loop While Not Found Is Nothing And Found. _
Address <> FirstAddress
End If

Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues)
If Reply = vbCancel Then End

If Reply = vbYes Then

'inserted copy text here


'LOSING IT HERE AT 'LOST'
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste



GoTo Finish:
End If

ThisAddress = FirstAddress.Address
Set CurrentArea = Selection
Do
If Intersect(CurrentArea, Selection) Is Nothing Then


With Selection
Set Found = .Find(What:=Lost, LookIn:=xlValues)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do

Set Found = .FindNext(Found)
Loop While Not Found Is Nothing And Found. _
Address <> FirstAddress
End If
End With
Selection.Copy

' Range("h1").Select
' ActiveSheet.Paste



Reply = MsgBox("Is this the " & Lost & " you're looking for?", _
vbQuestion + vbYesNoCancel, "Current Region")

Set Found = .Find(What:=Lost, LookIn:=xlValues)
If Not Found Is Nothing Then
FirstAddress = Found.Address

Set Found = .FindNext(Found)

End If

Set FirstAddress = .Find(What:=Lost, _
LookIn:=xlValues)
If Reply = vbCancel Then End
If Reply = vbYes Then

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