PDA

View Full Version : Search



sport1
05-02-2013, 04:58 PM
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
05-02-2013, 05:37 PM
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
05-03-2013, 01:25 AM
I'd like you to tell in plain english what you are trying to accomplish ?

sport1
05-03-2013, 05:44 AM
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
05-03-2013, 06:06 AM
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
05-03-2013, 06:24 AM
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
05-03-2013, 11:45 AM
You can set the scroll row/column as follows. This can be relative to the Found Cell if required
ActiveWindow.ScrollColumn = 2