Excel VBA code that copies data from one sheet to another

Question

I have written a VBA code that copies data from source sheets into destination sheets. The destination sheets are formatted as a table so that formulas can be calculated automatically to update a pivot graph.

I need to run the code daily. It works fine but a takes about 2 hours to run, some sheets have about 50,000 rows and about 3000 rows are added daily. My question is, is there a stack exchange site where I can find someone knowledgeable in VBA to review my code to make is run faster/more efficient? I've looked into ways of making VBA more efficient, but I'm not very familiar with it. Maybe I'm missing something.

EDIT: The code copies data from four different workbooks (each workbook has one sheet), into four different workbooks (three of the workbooks have one sheet, and one of the workbooks has two sheets). From each source sheet, it copies data starting from cell A9, selecting all cells with data below it and to its right (about 5 columns and 2000 - 6000 rows).

I've added the following to my code to make it run a bit faster but the I want to find other ways to make it run much faster:

Sub Auto_Open()

'Message box before running script
CarryOn = MsgBox("Do you want to update data?", vbYesNo, "Daily Traffic Report")
If CarryOn = vbYes Then

'Minimize workbook
ActiveWindow.WindowState = xlMinimized


'Switch to manual calculation of formulae
Application.Calculation = xlManual
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False


Dim x, y, o, p, u, j, k, s As Workbook
Dim win As Window
Dim LastRow As Long

Dim oFS As Object
Dim StrFile As String
Dim rot_cnt As Integer
rot_cnt = 1

Dim current As Date
Dim newest As Date
Dim right_file As String

Dim my_path As String
Dim file_name As String

'Source Files location
my_path = "C:\Users\xxxxx"

'Open latest source files
file_name = "filename*.xlsx"
StrFile = Dir(my_path & file_name)
Do While Len(StrFile) > 0
    Set oFS = CreateObject("Scripting.FileSystemObject")
    If rot_cnt = 1 Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
    End If
    If rot_cnt >= 1 Then
        current = oFS.GetFile(my_path & StrFile).DateCreated
    End If

    If DateSerial(Year(current), Month(current), Day(current)) >= _
    DateSerial(Year(newest), Month(newest), Day(newest)) _
    And Right(StrFile, 6) <> "*.xlsm" Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
        right_file = my_path & StrFile
    End If

    StrFile = Dir
    Set oFS = Nothing
    rot_cnt = rot_cnt + 1
Loop
Set x = Workbooks.Open(right_file)


file_name1 = "file_name1*.xlsx"
StrFile = Dir(my_path & file_name1)
Do While Len(StrFile) > 0
    Set oFS = CreateObject("Scripting.FileSystemObject")
    If rot_cnt = 1 Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
    End If
    If rot_cnt >= 1 Then
        current = oFS.GetFile(my_path & StrFile).DateCreated
    End If

    If DateSerial(Year(current), Month(current), Day(current)) >= _
    DateSerial(Year(newest), Month(newest), Day(newest)) _
    And Right(StrFile, 6) <> "*.xlsm" Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
        right_file = my_path & StrFile
    End If

    StrFile = Dir
    Set oFS = Nothing
    rot_cnt = rot_cnt + 1
Loop
Set o = Workbooks.Open(right_file)


file_name2 = "file_name2*.xlsx"
StrFile = Dir(my_path & file_name2)
Do While Len(StrFile) > 0
    Set oFS = CreateObject("Scripting.FileSystemObject")
    If rot_cnt = 1 Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
    End If
    If rot_cnt >= 1 Then
        current = oFS.GetFile(my_path & StrFile).DateCreated
    End If

    If DateSerial(Year(current), Month(current), Day(current)) >= _
    DateSerial(Year(newest), Month(newest), Day(newest)) _
    And Right(StrFile, 6) <> "*.xlsm" Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
        right_file = my_path & StrFile
    End If

    StrFile = Dir
    Set oFS = Nothing
    rot_cnt = rot_cnt + 1
Loop
Set p = Workbooks.Open(right_file)


file_name3 = "file_name3*.xlsx"
StrFile = Dir(my_path & file_name3)
Do While Len(StrFile) > 0
    Set oFS = CreateObject("Scripting.FileSystemObject")
    If rot_cnt = 1 Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
    End If
    If rot_cnt >= 1 Then
        current = oFS.GetFile(my_path & StrFile).DateCreated
    End If

    If DateSerial(Year(current), Month(current), Day(current)) >= _
    DateSerial(Year(newest), Month(newest), Day(newest)) _
    And Right(StrFile, 6) <> "*.xlsm" Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
        right_file = my_path & StrFile
    End If

    StrFile = Dir
    Set oFS = Nothing
    rot_cnt = rot_cnt + 1
Loop
Set j = Workbooks.Open(right_file)

'Open destination files
Set y = Workbooks.Open(ThisWorkbook.Path & "\f1.xlsx")

Set u = Workbooks.Open(ThisWorkbook.Path & "\f2.xlsx")

Set k = Workbooks.Open(ThisWorkbook.Path & "\f3.xlsx")

Set s = Workbooks.Open(ThisWorkbook.Path & "\f4.xlsx")

'Wait for 03s
Application.Wait (Now + TimeValue("0:00:03"))

'Minimize all excel files
For Each win In Windows
If win.Visible Then win.WindowState = xlMinimized
Next win

'Wait for 03s
Application.Wait (Now + TimeValue("0:00:03"))

'Copy data from source files into destination files
'2G Voice
x.Sheets("Sheet1").Range(x.Sheets("Sheet1").Range("A9"), x.Sheets("Sheet1").Range("A9").End(xlDown).End(xlToRight)).Copy
y.Sheets("xxxxx").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial

'2G Data
o.Sheets("Sheet1").Range(o.Sheets("Sheet1").Range("A9"), o.Sheets("Sheet1").Range("A9").End(xlDown).End(xlToRight)).Copy
y.Sheets("xxxxxx").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial

'3G Voice and Data
p.Sheets("Sheet1").Range(p.Sheets("Sheet1").Range("A9"), p.Sheets("Sheet1").Range("A9").End(xlDown).End(xlToRight)).Copy
u.Sheets("xxxx").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial

'4G Data
j.Sheets("Sheet1").Range(j.Sheets("Sheet1").Range("A9"), j.Sheets("Sheet1").Range("A9").End(xlDown).End(xlToRight)).Copy
k.Sheets("xxxxx").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial

'Total Traffic
x.Sheets("Sheet1").Range(x.Sheets("Sheet1").Range("A9"), x.Sheets("Sheet1").Range("A9").End(xlDown).End(xlToRight)).Copy
s.Sheets("xxxxxx").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial

'Disable alerts before closing/saving workbooks
Application.DisplayAlerts = False

x.Close
o.Close
p.Close
j.Close

'Save destination files
y.Save
u.Save
k.Save
s.Save

'Close destination files
y.Close
u.Close
k.Close
s.Close

'Refresh and Save current workbook
ThisWorkbook.RefreshAll
ThisWorkbook.Save

'Disable display alerts
Application.DisplayAlerts = True

'Switch to automatic calculation of formulae
Application.Calculation = xlAutomatic
ActiveWorkbook.PrecisionAsDisplayed = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

SendMail = MsgBox("Report complete. Send as attachement?", vbYesNo)
If SendMail = vbYes Then
'Mail last saved version of report
Call Mail_workbook_Outlook
Else
MsgBox ("Report Complete")
End If

End If



End Sub

Answer 1

A few items as I look through the code:

Use Option Explicit. Always. Every time. Every module. No exception.

When I added Option Explicit (well, OK, I have it set to always add it), your code won't compile because you are using undeclared variables. Without it, VBA "helpfully" declares any new variable name you type as a Variant. Variants have use, but they're slow and 99% of the time you don't need to use a variant, and your code is more readable and will be faster since VBA won't have to figure out what type of data the variable currently contains then convert it to what it thinks you need at this point.

Oh, VBA will also "helpfully" create 2 variables for when you use KeePass = "KeePass" in one place and If KeepPass <> vbNullString somewhere else, creating very difficult to track down bugs.

You can should have the VBE automatically insert Option Explicit for you in every code module by going to 'Tools | Options' then on the Editor tab check the Require Variable Declaration checkbox. Highly recommended.

Always. Every time.

---

Dim oFS As Object

Drop the Hungarian Notation. You use it inconsistently, so it's not egregious and overly offensive, but you, along with about 99.9% of other programmers use it inappropriately. Read this on why HN, as most people use it, is bad form. There's absolutely nothing wrong with it when used properly.

Additionally, there's no need to late bind oFS by declaring it as Object now, then later

Set oFS = CreateObject("Scripting.FileSystemObject")

unless, you expect there's the possibility that some machines your code may run on won't have the Scripting DLL installed and you've got error handling around it to catch that situation. Considering that every version of Windows since... Win95? (maybe earlier) has the Scripting DLL installed by default, it's highly unlikely you'll run into this situation.

An additional benefit of declaring it properly (Dim fileSystem as Scripting.FileSystemObject) is that you get Intellisense helping you at coding time, ensuring you're typing function names properly, minimizing typing (thanks auto-complete!), and getting parameter list prompts. Note: to early bind this, you'll have to add a reference Tools | References to Microsoft Scripting Runtime, but it's worth the few moments to make the one-time change to your project.

Another specific advantage for your code, as PeterT mentioned is that you only declare it once and don't have to create and destroy the object 7 times.

---

Do While Len(StrFile) > 0

the Dir() function returns "" if it doesn't find a matching file name or when it's exhausted the list of matching files. In VBA land, "" is the same as vbNullString, so lets use that to avoid the Len() function call to speed up your processing by just a smidge more.

---

Dim x, y, o, p, u, j, k, s As Workbook

Gives you 7 variant variables and one Workbook variable (s). These all seem to be assigned the result of a Workbook.Open() statement, so declaring them all as Workbook will a) make that more obvious, and b) eliminate the constant implicit conversion from Variant to Workbook.

While you're at it, give them some sort of meaningful names. Since you didn't pick 8 consecutive letters, they must mean something to you, make it easier on future you and anyone else who may have to look at your code and change those single letters to something helpful. You get 256 characters in a variable name, and with Intellisense helping, you won't ever have to type the whole variable name (once it's been Dimmed, that is).

---

'Source Files location
my_path = "C:\Users\xxxxx"

As written, that doesn't have a trailing \, so when you Dir(my_path & file_name), you'll get "c:\users\xxxxxfilename*.xlsx" which probably won't be found. This may simply be a copy/pasta/privacy/obsfucation error in your post, so it's probably a minor issue. You may consider writing a small function to ensure a path (passed to the function as a parameter) has a trailing slash, just to be sure.

---

If DateSerial(Year(current), Month(current), Day(current)) >= _
DateSerial(Year(newest), Month(newest), Day(newest)) _
And Right(StrFile, 6) <> "*.xlsm" Then
    newest = oFS.GetFile(my_path & StrFile).DateCreated
    right_file = my_path & StrFile
End If

Is rather difficult to read because of that first line continuation. Maybe it's a matter of style and preference, but if you put one complete condition on one line, it's much easier to mentally parse. No, the compiler doesn't care, so make it easier on the person reading it. If the line is too long for your liking, declare a couple of temporary variables to hold your dates. Maybe something like this:

Dim currentYear as Date
currentDate = DateSerial(Year(current), Month(current), Day(current))
Dim newestDate as Date
newestDate = DateSerial(Year(newest), Month(newest), Day(newest))
If  currentDate >= newestDate _
And Right(StrFile, 6) <> "*.xlsm" Then
    newest = oFS.GetFile(my_path & StrFile).DateCreated
    right_file = my_path & StrFile
End If

However, even that is way overkill! oFS.GetFile(my_path & StrFile).DateCreated kindly returns a Date which you're storing in either newest or current, so the first part of that If statement can read:

If current >= newest _
And ...

and simply be done with it. As you can see, though, it's now even less clear that current and newest are actually file dates, so you may want to consider renaming those to something a bit more meaningful and descriptive.

In that same If statement, there's a second condition

And Right(StrFile, 6) <> "*.xlsm" Then

If you look back up the code a bit, you'll notice

file_name = "filename*.xlsx"
StrFile = Dir(my_path & file_name)

See that *.xlsx" part of file_name? Yeah, you'll never get a *.xlsm file being returned by Dir() so this bit of the check is totally unnecessary. (NB: if you find that you are getting *.xlsm files when passing that file name mask to Dir() please file a bug report with Microsoft to save the rest of us from hitting this, too!)

While we're there, file_name is a poor choice for a variable name because of the _. VBA uses underscores in events and interfaces and it will create problems when implementing classes. It doesn't appear that this code is in a class, but if/when you do start writing classes, this will create problems for you, so it's probably best to get out of the habit of using them in the first place.

Assuming we meet the conditions of the If statement, we drop into the TRUE clause (for lack of a better term).

newest = oFS.GetFile(my_path & StrFile).DateCreated

You're now hitting the OS again to get the .DateCreated, but you've already got it stored in current. It would be much faster to do

newest = current

and be done with it.

Then there's

right_file = my_path & StrFile

Again, we've got an underscore, but why "Right"file? What makes it "right"? How 'bout something like mostCurrentSourceFileName. Sure it's longer, but with Intellisense, you'll only have to type it once and there will be no question about why it's the right file!

rot_cnt = rot_cnt + 1

OK, you're keeping track of whether you're testing the first file or not, but rot_cnt doesn't really tell me that. How 'bout

Dim firstFile As Boolean

and set firstFile = True before you start the loop, then unconditionally set firstFile = False within the loop. Now you know exactly what conditions you're looking for a few lines back where you're evaluating rot_cnt.

Finally, we get to:

Set oFS = Nothing

Frankly, since this is within the Do...Loop and you're recreating the object at the top of the loop, I'm not really certain how you're getting the newest file each time. Dir is known for giving you files back in a somewhat random order, but once it's been initialized with Dir(path & filemask) I believe it's pretty much guaranteed to give you every file matching the mask. Since you're killing the instance of the FSO that holds Dirs current pointer there's no telling what you're going to get each time through. That has to come out of the loop.

Put all those changes together and that little bit of code ends up looking something like this:

Const SOURCE_PATH As String = "c:\users\xxxx\"

Dim firstFile As Boolean
firstFile = False
Dim FSO As Scripting.FileSystemObject
Set FSO = New Scripting.FileSystemObject
Dim fileMask As String
fileMask = "Filename*.xlsx"

Dim currentFileName As String
currentFileName = Dir(SOURCE_PATH & currentFileName)
Do While currentFileName <> vbNullString
  If firstFile Then
    newest = FSO.GetFile(SOURCE_PATH & currentFileName).DateCreated
    current = newest
    firstFile = False
    Dim mostCurrentSourceFileName As String
    mostCurrentSourceFileName = currentFileName
  Else
    current = FSO.GetFile(SOURCE_PATH & currentFileName).DateCreated
  End If

  If current > newest Then
    mostCurrentSourceFileName = currentFileName
    newest = current
  End If

  currentFileName = Dir
Loop
Set x = Workbooks.Open(SOURCE_PATH & mostCurrentSourceFileName)

Yes, yes, there's an underscore in SOURCE_PATH, but someone, somewhere deemed it appropriate and conventional to shoutcase constant names and separate the words with _, so who am I to buck convention? Besides, as a Const, there won't be any issues with that being confused with an event handler, so that problem goes away.

---

Now that you've got that little bit of code cleaned up, you can copy/paste that yourself 8 times and change the variable names so that you aren't overwriting things. Oh, wait. That's a royal PITA, so make a Function out of it and call it 8 times! Something like this

Private Function GetNewestSourceFileFullName(ByVal fileMask As String) As String

    Const SOURCE_PATH As String = "c:\users\xxxx\"

    Dim firstFile As Boolean
    firstFile = False
    Dim FSO As Scripting.FileSystemObject
    Set FSO = New Scripting.FileSystemObject

    Dim currentFileName As String
    currentFileName = Dir(SOURCE_PATH & currentFileName)
    Do While currentFileName <> vbNullString
      If firstFile Then
        newest = FSO.GetFile(SOURCE_PATH & currentFileName).DateCreated
        current = newest
        firstFile = False
        Dim mostCurrentSourceFileName As String
        mostCurrentSourceFileName = currentFileName
      Else
        current = FSO.GetFile(SOURCE_PATH & currentFileName).DateCreated
      End If

      If current > newest Then
        mostCurrentSourceFileName = currentFileName
        newest = current
      End If

      currentFileName = Dir
    Loop

    GetNewestSourceFileFullName = SOURCE_PATH & mostCurrentSourceFileName

End Function

---

Now, it's a simple matter of

Set x = Workbooks.Open(GetNewestSourceFileFullName("filename*.xlsx"))
Set o = Workbooks.Open(GetNewestSourceFileFullName("file_name1*.xlsx"))
Set p = Workbooks.Open(GetNewestSourceFileFullName("file_name2*.xlsx"))

etc...

Now, if you ever need to change/fix the logic in GetNewestSourceFileFullName, you can do it once and not 8 times.

Oh, wait, I guess you only have to do it 4 times for x, o, p, and j. After reading through nearly 3/4 of the code, I finally discovered that those are the 4 source files. Did I mention that some better naming would help a lot?

---

I'm not sure what the Application.Wait()s are for, but if it floats your boat, they only add 6 seconds to the processing time.

Also, I'm not sure why you do the win.WindoState = xlMinimized, but again, if it floats your boat, go for it.

---

Hey, guess what! I just discovered that Workbooks object x is "2G Voice" data. I think I have a great new name for x and y:

Dim source2gVoice as Workbook
Dim destination2gVoice as Workbook

thanks to making the Function, we only need to change x to source2gVoice in one place - where we assigned the workbook!

---

I'm not a huge fan of the range.copy/range.paste methods of copying cells, but in this case where there are some unknown number of rows to be copied, this may well be the best way to do it.

I'm not certain what you're getting out of specifying .PasteSpecial, but that may be slowing down the copy. The default value for .PasteSpecial (which is what you're getting by not specifying a parameter to the method call) is xlPasteAll which is going to get you values and formatting and everything. If that's what you need, then carry on. If all you want is values then you need to specify xlPasteValues. Rummage through the Intellisense list of available options to make sure you're not pasting anything more than you need.