current community

your communities

more stack exchange communities

Stack Exchange
tour help
Take the 2-minute tour ×
Code Review Stack Exchange is a question and answer site for peer programmer code reviews. It's 100% free, no registration required.
up vote 5 down vote favorite

I am using a script to open a bunch of Excel files, copying two or more sheets into a new file and saving this new file. It sure beats doing it manually, but I think it could be faster.

Here's my script:

Sub Flujo()

Const FilePath = "A path..."
Const Destination = "Another path..."

Dim app As New Excel.Application
app.Visible = False
app.ScreenUpdating = False
app.DisplayAlerts = False

Dim str As String
str = Dir(FilePath & "\*.xlsx")
Do Until str = ""

    Dim WrkBook As Workbook
    Set WrkBook = app.Workbooks.Open(Filename:=FilePath & "\" & str, UpdateLinks:=0)
    str = Dir()

    Dim NewBook As Workbook
    Set NewBook = app.Workbooks.Add

    WrkBook.Sheets("SheetName").Copy After:=NewBook.Sheets(3)
    WrkBook.Sheets("AnotherSheetName").Copy After:=NewBook.Sheets(3)

    NewBook.Sheets(1).Delete
    NewBook.Sheets(1).Delete
    NewBook.Sheets(1).Delete

    NewBook.SaveAs Filename:=Destination & "flujo_" & WrkBook.Name
    NewBook.Close False
    WrkBook.Close False
Loop

app.DisplayAlerts = True

app.Quit
Set app = Nothing
End Sub

Is there a way I could make it work faster?

-Edit- The script takes more or less 3 - 6 seconds per file. That's not too much but I feel it could be much faster. Or is this the fastest I can expect to get with VBA?

share|improve this question

migrated from stackoverflow.com May 28 at 14:39

This question came from our site for professional and enthusiast programmers.
2  
Is WrkBook large? Which part of the code you feel is slower? The open, the moving of the sheets, the saving? –  kurast May 27 at 17:43
    
It's not very large, and I can't know which step takes the longest because the script does everything automatically. –  user3680808 May 27 at 17:56
    
How long does it take, and how long would you like it to take? Opening the source workbook as readonly might be slightly faster. When you add the new workbook you can specify only one sheet [Workbooks.Add(xlWBATWorksheet)], so then you have fewer sheets to delete later. Otherwise there don't seem to be any clear ways to really speed this up unless you're opening/saving on a slow network and not a local drive. –  Tim Williams May 27 at 17:57
    
Edited the original post. –  user3680808 May 27 at 18:00
1  
Small changes would be to temporarily turn off calculation: Application.Calculation = xlCalculationManual, use the WorkSheets collection rather than Sheets. Also, if the workbooks are saved to a remote location, you might save them locally then, afterwards, copy them to the remote location. –  Andy G May 27 at 18:00
show 1 more comment

3 Answers

up vote 5 down vote

Rather than copying sheet by sheet - plus deleting three excess sheets one by one, either

  1. Delete the sheets you don't need then use SaveAs on the reduced file.
  2. Copy both sheets you need to a new file in a single hit.

(Also, don't Dim variables inside a loop)

(2) below

Sub Flujo()

Const FilePath = "A path..."
Const Destination = "Another path..."
Dim xlApp As New Excel.Application

With xlApp
    .Visible = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Dim strDir As String
Dim WrkBook As Workbook

strDir = Dir(FilePath & "\*.xlsx")

Do While Len(strDir) > 0      
Set WrkBook = xlApp.Workbooks.Open(Filename:=FilePath & "\" & strDir, UpdateLinks:=0)
  WrkBook.Sheets(Array("SheetName", "AnotherSheetName")).Copy
  ActiveWorkbook.SaveAs Filename:=Destination & "flujo_" & WrkBook.Name
  ActiveWorkbook.Close False
  WrkBook.Close False
strDir = Dir 
Loop

xlApp.DisplayAlerts = True

xlApp.Quit
Set xlApp = Nothing
End Sub
share|improve this answer
1  
Dim variables inside a loop has no importance in VBA (it does in VB.NET though) - but I agree with the recommendation, for readability purposes. +1 –  Mat's Mug May 28 at 14:39
add comment
up vote 4 down vote

The biggest bottle neck here is Dim app As New Excel.Application. Opening up a brand new excel instance is costly even if you do it once. Instead you can grab an existing instance of Excel (if there is one) if not then you can create a new one still. The rest of your code is pretty simple.

Function GetExcelApplication(Optional ByRef WasANewInstanceReturned As Boolean) As Excel.Application

    If ExcelInstanceCount > 0 Then
        Set GetExcelApplication = GetObject(, "Excel.Application")
        WasANewInstanceReturned = False
    Else
        Set GetExcelApplication = New Excel.Application
        WasANewInstanceReturned = True
    End If
End Function

Function ExcelInstanceCount() As Integer
    Dim objList As Object, objType As Object, strObj As String
    strObj = "Excel.exe"
    Set objType = GetObject("winmgmts:").ExecQuery("select * from win32_process where name='" & strObj & "'")
    ExcelInstanceCount = objType.Count
End Function

Another thing to be aware of is that you are deleting three sheets, NewBook.Sheets(1).Delete, but this assumes an excel workbook opens with three sheets in it already. Not everyone has their excel set up this way. you might end up deleting the data you just copied in.

share|improve this answer
    
The thing is I'm not opening a new Excel instance every time, if you take a look at the code, the instance is created at the beginning and then the loops goes through all the files using that same app. –  user3680808 May 27 at 17:47
    
ah, very true. edited. –  Brad May 27 at 17:53
    
That was just the thing that stood out to me. But you could say what line is slowest, it would be helpful. How slow is 'slow'? –  Brad May 27 at 17:54
    
I added that as an edit to the original post. –  user3680808 May 27 at 18:00
add comment
up vote 2 down vote

Do you have anything 'fancy' in your sheet? (i.e. special formatting, pivots, formulas?) If not -- or even if you do, but with more work -- you should be able to copy the values into Sheet1 and rename, rather than move the entire sheet.

Modifying your Loop to work with a pure data (no formatting) example:

Do Until str = ""

    Dim WrkBook As Workbook
    Set WrkBook = app.Workbooks.Open(Filename:=FilePath & "\" & str, UpdateLinks:=0)
    str = Dir()

    Dim NewBook As Workbook
    Set NewBook = app.Workbooks.Add

    NewBook.Sheets(1).Name = "SheetName"
    NewBook.Sheets(2).Name = "AnotherSheetName"
    NewBook.Sheets(3).Delete

    NewBook.Sheets("SheetName").Range("A1:D100").Value = WrkBook.Sheets("SheetName").Range("A1:D100").Value
    NewBook.Sheets("AnotherSheetName").Range("A1:D100").Value = WrkBook.Sheets("AnotherSheetName").Range("A1:D100").Value
    ' Use of a specific range if known is best, though you could use .Cells, but this is likely to be slower
    ' NewBook.Sheets("SheetName").Cells.Value = WrkBook.Sheets("SheetName").Cells.Value
    ' There are other methods around to identfy the usable range as well
    ' Dim lMaxRow As Long
    ' With WrkBook.Sheets("SheetName")
    '     lMaxRow .Range("D" & .Rows.CountLarge).End(xlUp).Row
    ' End With
    ' NewBook.Sheets("SheetName").Range("A1:D" & lMaxRow).Value = WrkBook.Sheets("SheetName").Range("A1:D" & lMaxRow).Value


    NewBook.SaveAs Filename:=Destination & "flujo_" & WrkBook.Name
    NewBook.Close False
    WrkBook.Close False
Loop
share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.