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:\Charts\1\ and c:\Charts\0\. 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:\Charts\1\"
Pathname="c:\charts\0\"
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

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.

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