Search

[sport1]

I am having trouble with the search function after I select a directory for a workbook to search.
The code is doing part of what it supposed to do. It open and runs through each workbook in the directory. But it is not finding the value I am searching for in each of the worksheet. It just continues to open all the different workbooks in the directory. I am missing something but not sure what.
The search is working fine in the beginning of the code. It just when I go to search the directory that it is not finding the value I enter in my textbox. Could you help me

Option Explicit

Sub test_1()
    Dim ws     As Worksheet
    Dim rFound As Range
    Dim strName As String
    Dim doyou  As String
    Dim docopy$
    Dim xArea  As Range
    Dim eArea  As Range
    Dim xData  As Workbook
    Dim xName$, ePath$
    Dim fPicker As Object
    Dim bsearch$
    With Application
        '    .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    docopy = MsgBox("Do you want to copy?", vbYesNo)
    If docopy = vbYes Then
        Set xArea = Application.InputBox(prompt:="Copy Area", title:="Select Range", Type:=8)
        Rem any select any worksheet And cell
        strName = InputBox("Enter Cross Ref#")
        If strName = "" Then Exit Sub
        For Each ws In Worksheets
            With ws.UsedRange
                Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
                If Not rFound Is Nothing Then
                    Application.Goto rFound, True
                    doyou = MsgBox("Do you want to continue searching?", vbYesNo)
                    If doyou = vbNo Then Exit Sub
                    End If
            End With
        Next ws
        MsgBox "Value not found"
    End If
    doyou = MsgBox("Do you want to Search Directory?", vbYesNo)
    If doyou = vbNo Then Exit Sub
    Do
        Set fPicker = Application.FileDialog(msoFileDialogFolderPicker)
        With fPicker
            .Show
            ePath = .SelectedItems(1) & "\"
        End With
        xName = Dir(ePath & "*.xls*")
        Do While Len(xName) > 0
            Set xData = Workbooks.Open(ePath & xName)
            For Each ws In Worksheets
                With ws.UsedRange
                    Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
                    If strName = "" Then Exit Sub
                    If Not rFound Is Nothing Then
                        Application.Goto rFound, True
                        doyou = MsgBox("Do you want to continue searching?", vbYesNo)
                        If doyou = vbNo Then Exit Sub
                   End If
                   xData.Close False
                   xName = Dir
            End With
        Next ws
    Loop
    bsearch = MsgBox("Value not found, do you want to search another directory?", vbYesNo)
    Loop Until bsearch = vbNo
    With Application
        ' .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    MsgBox "Value not found"
End Sub

[GTO]

The search is working fine in the beginning of the code. It just when I go to search the directory that it is not finding the value I enter in my textbox. Could you help me

Greetings,

I am guessing that this is a first step? I only say that as I don't see why we are using GoTo and not doing anything with the data (at least as far as I can tell).

Anyways, I stepped through the code only once, so I may be missing stuff, but I did catch this:

        Do While Len(xName) > 0
    Set xData = Workbooks.Open(ePath & xName)
    For Each ws In Worksheets
        With ws.UsedRange
            Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
            If strName = "" Then Exit Sub
            If Not rFound Is Nothing Then
                Application.Goto rFound, True
                doyou = MsgBox("Do you want to continue searching?", vbYesNo)
                If doyou = vbNo Then Exit Sub
            End If
            xData.Close False
            xName = Dir
        End With
    Next ws
        Loop

You are closing the workbook after only the first sheet has been looked at. I think you want to move the red part to after the Next ws and before Loop.

Hope that helps,

Mark

[snb]

I'd like you to tell in plain english what you are trying to accomplish ?

[sport1]

Hi I moved the xData.Close False after the Next ws and before the loop as you said. I ran the through the code and it was working fine. then I received this error message (Run-Time error '5: Invalid procedure call or argument.)
The error seems to be on the( xname = Dir).

Sub test_1()
    Dim ws     As Worksheet
    Dim rFound As Range
    Dim strName As String
    Dim doyou  As String
    Dim docopy$
    Dim xArea  As Range
    Dim eArea  As Range
    Dim xData  As Workbook
    Dim xName$, ePath$
    Dim fPicker As Object
    Dim bsearch$
    With Application
        '    .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    docopy = MsgBox("Do you want to copy?", vbYesNo)
    If docopy = vbYes Then
        Set xArea = Application.InputBox(prompt:="Copy Area", title:="Select Range", Type:=8)
        Rem any select any worksheet And cell
        strName = InputBox("Enter Cross Ref#")
        If strName = "" Then Exit Sub
        For Each ws In Worksheets
            With ws.UsedRange
                Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
                If Not rFound Is Nothing Then
                    Application.Goto rFound, True
                    doyou = MsgBox("Do you want to continue searching?", vbYesNo)
                    If doyou = vbNo Then Exit Sub
                End If
            End With
        Next ws
        MsgBox "Value not found"
    End If
    doyou = MsgBox("Do you want to Search Directory?", vbYesNo)
    If doyou = vbNo Then Exit Sub
    Do
        Set fPicker = Application.FileDialog(msoFileDialogFolderPicker)
        With fPicker
            .Show
           ePath = .SelectedItems(1) & "\"
        End With
        xName = Dir(ePath & "*.xls*")
        Do While Len(xName) > 0
            Set xData = Workbooks.Open(ePath & xName)
            For Each ws In Worksheets
                With ws.UsedRange
                    Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
                    If strName = "" Then Exit Sub
                    If Not rFound Is Nothing Then
                        Application.Goto rFound, True
                        doyou = MsgBox("Do you want to continue searching?", vbYesNo)
                        If doyou = vbNo Then Exit Sub
                    End If
                                    xName = Dir
                End With
            Next ws
            xData.Close False
        Loop
        bsearch = MsgBox("Value not found, do you want to search another directory?", vbYesNo)
    Loop Until bsearch = vbNo
    With Application
        ' .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    MsgBox "Value not found"
End Sub

[GTO]

Off to bed for this lad (It is 0600 hours here...). Post a workbook, any sensitive data faked of course, but accurately portrayed as to locations (cell-wise) and data type.

I must agree with snb on this: try and describe what we are trying to do reference the values (or surrounding data) once we find said data.

[sport1]

Thank you for your help I was able to figure the issue out. But I do have one more question for you.
When I run the code to find the value that I am search for in each of the workbooks. it focus on that cell that he value is found. which is usually to the right. How do I get the spreadsheet to be center so I can see everything in the spreadsheet?

Option Explicit

Sub test_1()
    Dim ws     As Worksheet
    Dim rFound As Range
    Dim strName As String
    Dim doyou  As String
    Dim docopy$
    Dim xArea  As Range
    Dim eArea  As Range
    Dim xData  As Workbook
    Dim xName$, ePath$
    Dim fPicker As Object
    Dim bsearch$
    With Application
        '    .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    docopy = MsgBox("Do you want to copy?", vbYesNo)
    If docopy = vbYes Then
        Set xArea = Application.InputBox(prompt:="Copy Area", title:="Select Range", Type:=8)
        Rem any select any worksheet And cell
        strName = InputBox("Enter Cross Ref#")
        If strName = "" Then Exit Sub
        For Each ws In Worksheets
            With ws.UsedRange
                Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
                If Not rFound Is Nothing Then
                    Application.Goto rFound, True
                    doyou = MsgBox("Do you want to continue searching?", vbYesNo)
                    If doyou = vbNo Then Exit Sub
                End If
            End With
        Next ws
        MsgBox "Value not found"
    End If
    doyou = MsgBox("Do you want to Search Directory?", vbYesNo)
    If doyou = vbNo Then Exit Sub
    Do
        Set fPicker = Application.FileDialog(msoFileDialogFolderPicker)
        With fPicker
            .Show
            ePath = .SelectedItems(1) & "\"
    End With
    xName = Dir(ePath & "*.xls*")
    Do While Len(xName) > 0
        Set xData = Workbooks.Open(ePath & xName)
        For Each ws In Worksheets
            With ws.UsedRange
                Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
                If strName = "" Then Exit Sub
                If Not rFound Is Nothing Then
                    Application.Goto rFound, True
                    doyou = MsgBox("Do you want to continue searching?", vbYesNo)
                    If doyou = vbNo Then Exit Sub
                End If
            End With
         Next ws
         xData.Close False
         xName = Dir
    Loop
    bsearch = MsgBox("Value not found, do you want to search another directory?", vbYesNo)
    Loop Until bsearch = vbNo
    With Application
        ' .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    MsgBox "Value not found"
End Sub

[mdmackillop]

You can set the scroll row/column as follows. This can be relative to the Found Cell if required

ActiveWindow.ScrollColumn = 2