PDA

View Full Version : Run-Time Error '424' Object Required



sport1
05-15-2013, 12:00 PM
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


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

Kenneth Hobs
05-15-2013, 12:58 PM
My guess is that xArea was not selected. Try selecting a range once and then just close the input box without selecting a range.

Check If xArea = Nothing. You may need an On Error to handle errors in some parts.

SamT
05-15-2013, 08:56 PM
Cross posting.

http://www.excelkey.com/forum/viewtopic.php?f=3&t=3454

http://www.vbaexpress.com/forum/showthread.php?t=46158
http://www.vbaexpress.com/forum/showthread.php?t=46146