I am getting this (Run-time error '424' object required). this happens after selecting a directory to continue the search. As the code is running it hits this part of the code --> (xArea.Copy eArea ) then give me that Run-time error. can you help me fix this issue then I beleive that we may have it.
Thanks
[VBA]
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
docopy = MsgBox("Do you want to Paste?", vbYesNo)
If docopy = vbYes Then
Do
Set eArea = Application.InputBox(prompt:="Copy to", title:="Select one cell", Type:=8)
Loop Until eArea.Cells.Count = 1
xArea.Copy eArea
Rem Or just To the same worksheet
' Worksheets("Results").Range("A" & Worksheets("Results").Rows.Count).End(xlUp).Offset(1, 0)
End If
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 Not rFound Is Nothing Then
Application.Goto rFound, True
docopy = MsgBox("Do you want to Paste?", vbYesNo)
If docopy = vbYes Then
Do
Set eArea = Application.InputBox(prompt:="Copy to", title:="Select one cell", Type:=8)
Loop Until eArea.Cells.Count = 1
xArea.Copy eArea
Rem Or just To the same worksheet
' Worksheets("Results").Range("A" & Worksheets("Results").Rows.Count).End(xlUp).Offset(1, 0)
End If
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
[/VBA]
Reply With Quote
