PDA

View Full Version : Visual Basic run-time error 1004 work around



midori323
09-21-2016, 09:12 AM
Hi, guys,

I was trying to extract data from multiple Excel workbook using VBA and since the target cells to extract data is only 2,
I thought it's fairly straightforward code...and wrote the code below:



Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
MyFile = Dir("C:\Users\ahozumi\Desktop\Business sheet\")
Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If
Workbooks.Open (MyFile)
Range("A5,K27").Copy
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 2))
MyFile = Dir
Loop
End Sub

And when I ran this code, I got this "run-time error 1004"....indicating the file
couldn't be found.
Somehow, it even specified the file name in the folder("BRTwk25.xlsx")and stated this file cannot be found...

Can anyone advise me how to fix this error?


Thanks in advance!


Midori323

Kenneth Hobs
09-21-2016, 12:58 PM
You need to prefix the foldername (concatenate) to the filename. e.g.

Workbooks.Open "C:\Users\ahozumi\Desktop\Business sheet\" & MyFile

midori323
09-22-2016, 03:09 AM
Thank you, Kenneth,

I changed the 9th line and now the problem of opening the target file has been fixed....
But now I have the problem of defining the target cells to copy...
I've got a couple of error messages relating to line 10,,, "Range ("A5, K27").Open
So I changed it and now the code is revised as per below:


Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
MyFile = Dir("C:\Users\ahozumi\Desktop\Business sheet\")
Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If
Workbooks.Open "C:\Users\ahozumi\Desktop\Business sheet\" & MyFile
Range(Cells(5, 1), Cells(27, 11)).Copy
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 2))
MyFile = Dir
Loop

And I still get this run time error 1004, stating "paste method of worksheet class failed"..
How can I fix this problem..?

Any suggestion or recommendation is appreciated!

Midori323

Kenneth Hobs
09-22-2016, 06:45 AM
Please paste code between code tags. Type them or click the # icon on the toolbar to insert them. It is easy to troubleshoot and help that way.

I prefer Range over Cells most time as Range allows intellisense to work. As such, when you type the period after the Range object, you would see that there is no Open method. For you paste range, cells would be fine. You many need a WorksheetFunction.Transpose though.

You may want to add False after the ActiveWorkbook.Close. Your Copy/Paste can be on one line. It might go something like:


erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Workbooks.Open CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Business sheet\" & MyFile
Range("A5,K27").Copy ThisWorkbook.Sheet1.Range(Cells(erow, "A"), Cells(erow, "B"))
ActiveWorkbook.Close False

midori323
09-23-2016, 09:26 AM
Hi, Kenneth,

Thank you for your advice.

I've never used CreateObject or WScript but used them to replace my previous code.
Now it looks like

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
MyFile = Dir("C:\Users\ahozumi\Desktop\Business sheet\")

Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Workbooks.Open CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Business sheet\" & MyFile
Range("A5", "K27").Copy ThisWorkbook.Sheet1.Range(Cells(erow, "A"), Cells(erow, "B"))

ActiveWorkbook.Close False


Loop


End Sub



But now I've got Compile error saying "Method or data member not found".
I thought I need Paste command but when I tried to insert .Paste
after .Copy, I got compile error...

So I used
ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 2))


But again I got compile error...

Where should I insert paste command in this case..?


Thank you for your help.

Midori

Kenneth Hobs
09-23-2016, 10:03 AM
I am not a big fan of mixing sheet code and sheet names. This might be a bit more simple.

Sub LoopThroughDirectory()
Dim MyFile As String, erow As Long, ws As Worksheet

MyFile = Dir(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Business sheet\")

Set ws = ThisWorkbook.Worksheets("Sheet1")

Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If

erow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Workbooks.Open CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Business sheet\" & MyFile
Range("A5", "K27").Copy ws.Range(Cells(erow, "A"), Cells(erow, "B"))

ActiveWorkbook.Close False
Loop
End Sub

midori323
09-26-2016, 04:32 AM
I am not a big fan of mixing sheet code and sheet names. This might be a bit more simple.

Sub LoopThroughDirectory()
Dim MyFile As String, erow As Long, ws As Worksheet

MyFile = Dir(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Business sheet\")

Set ws = ThisWorkbook.Worksheets("Sheet1")

Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If

erow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Workbooks.Open CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Business sheet\" & MyFile
Range("A5", "K27").Copy ws.Range(Cells(erow, "A"), Cells(erow, "B"))

ActiveWorkbook.Close False
Loop
End Sub

midori323
09-26-2016, 04:46 AM
Thank you again, Kenneth,

I tried to use your code and now I have an error message on the fourth line..i.e.,


Set ws =ThisWorkbook.Worksheets("Sheet1")


The error message I got this time was "compile error: End of statement"
So I added semi colon on the left side of the equation but still get the
same error message....

I rewrote the code as
[CODE]
Dim ws As Worksheet[
ws=ThisWorksbook.Worksheet("Sheet1")
/CODE]

But didn't work either...

I don't know why it didn't work and I really appreciate your help.

Thanks in advance,


Midori

Kenneth Hobs
09-26-2016, 05:11 AM
Do you know what ThisWorkbook object is? It is the workbook that the macro resides in. Check your spelling as you used ThisWorksbook".

If the tabname or sheetname in ThisWorkbook <> "Sheet1" then it will error if you try to set such. Note that the sheetname is not always the same as the codename.


So I added semi colon on the left side of the equation but still get the
same error message....Why?

midori323
09-26-2016, 09:12 AM
Do you know what ThisWorkbook object is? It is the workbook that the macro resides in. Check your spelling as you used ThisWorksbook".

If the tabname or sheetname in ThisWorkbook <> "Sheet1" then it will error if you try to set such. Note that the sheetname is not always the same as the codename.

Why?

midori323
09-26-2016, 09:16 AM
Hi, Kenneth,

Sorry, the code I typed in my previous thread has typos.. There was
no "s" in my original VBA code.
I added semi colon as some trouble shooting tip suggested when I get
error end statement, semi colon or period is missing..

Kenneth Hobs
09-27-2016, 05:23 AM
I don't use semicolons. Please paste your code.

As I said, if the sheetname/tabname does not exist, it will error. Here is an example to test for that.

Function Test_WorkSheetExists() MsgBox "WorksheetExists? " & WorkSheetExists("Sheet1"), _
vbInformation, "ActiveWorkbook.ActiveSheet"

MsgBox "WorksheetExists? " & WorkSheetExists("ken", "ken.xlsm"), _
vbInformation

MsgBox "WorksheetExists? " & WorkSheetExists("Sheet1", ThisWorkbook.Name), _
vbInformation
End Function


'WorkSheetExists in a workbook:
Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
Dim ws As Worksheet, wb As Workbook
On Error GoTo notExists
If sWorkbook = "" Then
Set wb = ActiveWorkbook
Else
Set wb = Workbooks(sWorkbook) 'sWorkbook must be open already. e.g. ken.xlsm, not x:\ken.xlsm.
End If
Set ws = wb.Worksheets(sWorkSheet)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function

midori323
09-27-2016, 08:01 AM
Hi, Kenneth,

Thank you for your help again....but I don't think the missing sheet name or tabname is causing this error.
Because if I revert to my original code I uploaded in this forum,


Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
MyFile = Dir("C:\Users\ahozumi\Desktop\Business sheet\")
Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If
Workbooks.Open (MyFile)
Range("A5,K27").Copy
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 2))
MyFile = Dir
Loop
End Sub



And change the line 10, the definition of range to

Range.("J27:K27").Copy
This code worked to copy the cells from 6 workbook in "Business sheet" folder and paste on the area specified in
Active sheet....


But once I change the range specification to select 2 disperse cells in the worksheet, I encounter error message....

So I wonder Range cannot specify cells which are not contiguous...
I referred various guidance and tips and most examples used Range to specify cells which are contiguous....
But none of the reference said you cannot use Range to specify 2 or more disperse cells.

If I use Range, can't I specify two disperse cells like "A5" and "J27" like

Range("A5","J25").Copy

...?

Kenneth Hobs
09-27-2016, 08:15 AM
When you copy like that, you MUST paste to the same number of rows and columns. While we can use Resize in the destination, the easier way is to paste to just one cell. e.g.

Worksheets(1).Range("A5", "J25").Copy Worksheets(2).Range("A1")
Of course you used a consecutive range just as if it was A5:J25.

If you want to use non-consecutive range(s), then more work is needed. e.g.

Sub Test()
'Worksheets(1).Range("A5", "J25").Copy Worksheets(2).Range("A1")

'Worksheets(1).Range("A5,J25").Copy Worksheets(2).Range("A1") 'Errors, non-consective

Dim a() As Variant
a() = RangeTo1dArray(Worksheets(1).Range("A5,J25"))
Worksheets(2).Range("A1").Resize(UBound(a) + 1).Value = WorksheetFunction.Transpose(a)
End Sub




Sub Test_RangeTo1dArray()
Dim v As Variant, a() As Variant
a() = RangeTo1dArray(ActiveSheet.UsedRange)


For Each v In a()
Debug.Print v
Next
End Sub


Function RangeTo1dArray(aRange As Range) As Variant
Dim a() As Variant, c As Range, i As Long
ReDim a(0 To aRange.Cells.Count - 1)
i = i - 1
For Each c In aRange
i = i + 1
a(i) = c
Next c
RangeTo1dArray = a()
End Function