Copying a range from one file to another

Question

Since it has too many loop, loop inside loop, this works very slowly. How can we increase the speed of this program? I am trying to copy a range from one file to another file of same name in different folder. I have folders named "A","B","C"..."G" inside c:\Charts1円\ and c:\Charts0円\. Inside each folder "A","B","C"..."G" there are files named 1,2,3,4,..10.

dim vArr1 as array
Dim vArr as array
vArr1 = Array("A", "B", "C", "D", "E", "F", "G")
vArr = Array("A", "B", "C", "D", "E", "F", "G")
Dim fileName1, Pathname1 As String
Pathname1 = "c:\Charts1円\"
Pathname="c:\charts0円\"
For Each vFile1 In vArr1
 fileName1 = Dir(Pathname1 & vFile1 & "\" & "*.xlsx")
 Do While fileName1 <> ""
 For Each vFile In vArr
 filename = Dir(Pathname & vFile & "\" & "*.xlsx")
 Do While filename <> ""
 If filename = fileName1 Then
 Set WB1 = Workbooks.Open(Pathname1 & vFile & "\" & fileName1)
 WB1.Application.ScreenUpdating = False
 WB1.ActiveSheet.Range("M1:M30").Copy
 WB1.Close (False)
 Set WBD1 = Workbooks.Open(Pathname & vFile & "\" & filename)
 WBD1.ActiveSheet.Range("C1").Select
 WBD1.ActiveSheet.Paste
 WBD1.ActiveSheet.Cells(1, 3).Value = "HSI Q4 2014-15"
 WBD1.Close (True)
 filename = Dir()
 Else
 End If
 fileName1 = filename
 Loop
 Next
 Loop
Next

• Raystafarian: I feel like some of your code here is missing
• Mathieu Guindon: Me too. Is this the entire procedure? How about you include the Sub ... End Sub part? Also, are vFile variables declared at module-scope or simply undeclared? I strongly recommend sticking Option Explicit at the top of your module.
• Abdul Shiyas: Yes, It's incomplete only. I have same other actions like converting files to csv and all is there. vFile, vFile1 are declared using Dim .
• Comintern: Are you sure this is working code? The nested calls to Dir() should only give you the first set of files in the inner-most loop. The second time you call it, it blows away the first result.

Answer 1

Nitpicks First

Why have you duplicated the array?

vArr1 = Array("A", "B", "C", "D", "E", "F", "G")
vArr = Array("A", "B", "C", "D", "E", "F", "G")

You could use the same array for both loops.

fileName1 = Dir(Pathname1 & vFile1 & "\" & "*.xlsx")

The Microsoft Scripting Runtime has a FileSystemObject with a BuildPath method. It takes care of those pesky backslashes for you.

Dim fso as New FileSystemObject
fileName1 = Dir(fso.BuildPath(Pathname1,fso.BuildPath(vFile1, "*.xlsx")))

But now that we've added a reference to the runtime, and we have a FileSystemObject, there's no reason to keep using Dir. We might as well be consistent and use the fso.

Dim fso As New FileSystemObject
Dim path As String
path = fso.BuildPath(Pathname1,fso.BuildPath(vFile1, "*.xlsx"))
Dim f As File
For Each f In fso.GetFolder(path)
 ' ...
Next f

But we want to make it faster...

Like Mat's Mug said in his answer, the reason it's slow is because you're opening workbooks up in a loop. Truthfully though, there's another issue slowing you down. You're hitting the clipboard with that copy/paste. What I'm going to recommend should solve both issues.

Now, you're still going to have to open up the destination workbook AFAIK, but you don't have to open up the source book. You can query it using ADODB instead. Once you've got a recordset to work with, you can quickly paste into the destination using the CopyFromRecordset method of Range.

Combining those techniques should give you a significant performance boost.

• RubberDuck: One last thing I forgot to mention. You say this isn't the complete code. This should be a subroutine in it's own right. Extract it from where ever it is into it's own thing.
• Mathieu Guindon: "subroutine" != "procedure" ...you meant "procedure" I'm sure ;-)
• RubberDuck: Yeah yeah @Mat'sMug. Semantics. A subroutine is a specific kind of procedure. =;)-
• Mathieu Guindon: I hear "subroutine" and think GoSub/Return ...and shiver.
• RubberDuck: It is fun @paulbica! For some values of fun. =;)- I don't want to get too chatty here, but did you know there's a VBA chatroom?

Answer 2

I doubt this is how you've actually declared arrays:

dim vArr1 as array
Dim vArr as array

That would be

Dim vArr1() As String
Dim vArr() As String

But nevermind that: you need to use more meaningful names. If they're folder names, consider calling them something like folders or folderNames - and avoid arbitrary Hungarian-like prefixes such as v.

---

This is why multiple declarations in the same instruction should be avoided:

Dim fileName1, Pathname1 As String

Do you think fileName1 is a String? It's not. It's implicitly declared as Variant, because As String only applies to Pathname1!

---

Indentation is off here, and only looks the way it does because WB1 has 3 characters (and it's another bad name):

Set WB1 = Workbooks.Open(Pathname1 & vFile & "\" & fileName1)
 WB1.Application.ScreenUpdating = False
 WB1.ActiveSheet.Range("M1:M30").Copy
 WB1.Close (False)

Should be:

Set WB1 = Workbooks.Open(Pathname1 & vFile & "\" & fileName1)
WB1.Application.ScreenUpdating = False
WB1.ActiveSheet.Range("M1:M30").Copy
WB1.Close (False)

---

Note that your usage of parenthesis in method calls is going to cause a bug one day or another, when you pass an argument like that into a ByRef parameter.

How so? Well, the "normal" VBA syntax for passing arguments is like this:

WB1.Close False

By doing this:

WB1.Close (False)

You are forcing the argument to be passed ByVal, overriding the procedure's signature that might have said ByRef. Of course it doesn't really matter here for a Boolean literal..

Workbooks.Open(Pathname1 & vFile & "\" & fileName1)

...or even for a String literal. But one day you're going to want to pass an argument into a ByRef parameter, and learn the hard way that parentheses should be dropped when doing procedure calls. They're only needed for function calls.

---

The main reason why your code is slow is because you're opening and closing workbooks - there's not really anything to do to speed that up unfortunately.

Except perhaps...

WB1.Application.ScreenUpdating = False

Take that part out of the loop, and turn off screen updating all the while.

Application.ScreenUpdating = False

Now, whenever you turn off screen updating, you need to turn it back on when you're done, and you need to handle runtime errors and make sure you're turning it back on even when an error breaks you out of the code. You're accessing the file system here, so you have to handle runtime errors.

See this post for how to properly handle errors in VBA.

Answer 3

All the other answers are all useful, but reducing the number of files being opened will make the biggest difference, I think. You can reduce this by restructuring the code to be (more) like the example below (see my comments tagged #HARVEY below)

For Each vFile1 In vArr1
 fileName1 = Dir(Pathname1 & vFile1 & "\" & "*.xlsx")
 Do While fileName1 <> ""
 ' #HARVEY: 
 ' Open this file once and keep it open while you copy to 
 ' all the other files that have the same name 
 Set WB1 = Workbooks.Open(Pathname1 & vFile & "\" & fileName1)
 ' #HARVEY:
 ' As mentioned in other answers, there are better ways to do copy the
 ' data out but you set the the reference to the data to be copied here
 WB1.ActiveSheet.Range("M1:M30").Copy
 For Each vFile In vArr
 filename = Dir(Pathname & vFile & "\" & "*.xlsx")
 Do While filename <> ""
 If filename = fileName1 Then
 Set WBD1 = Workbooks.Open(Pathname & vFile & "\" & filename)
 WBD1.ActiveSheet.Range("C1").Select
 WBD1.ActiveSheet.Paste
 WBD1.ActiveSheet.Cells(1, 3).Value = "HSI Q4 2014-15"
 WBD1.Close (True)
 filename = Dir()
 Else
 End If
 fileName1 = filename
 Loop
 Next
 Loop
 WB1.Close (False)
Next