Importing files into Excel

Question

Any tips to reduce lines, improve speed, or any cool thing, are welcome.

I have been using this for years and I just realized, why not improve ...?

Sub AtualizarRelatorioGeral()
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.DisplayAlerts = False
 SaveChanges = False
 Dim Arquivo(18) As String
 Arquivo(1) = "zpp03ontem"
 Arquivo(2) = "vl10a"
 Arquivo(3) = "mb51consumomensal"
 Arquivo(4) = "mb51repassegerado"
 Arquivo(5) = "mb52peixerev"
 Arquivo(6) = "mb52peixepro"
 Arquivo(7) = "mb52exp"
 Arquivo(8) = "mb52repassesaldo"
 Arquivo(9) = "zsd17"
 Arquivo(10) = "zsd25fat"
 Arquivo(11) = "zsd25dev"
 Arquivo(12) = "mc.9estoquecd"
 Arquivo(13) = "mc.9consumo"
 Arquivo(14) = "mc.9centro"
 Arquivo(15) = "mc.9cdhipet"
 Arquivo(16) = "mc.9valor"
 Arquivo(17) = "zpp25"
 Arquivo(18) = "mc.9produto"
 For i = 1 To 18
 Sheets(Arquivo(i)).Visible = True
 Next i
 Set WBgeral = ActiveWorkbook
 'IMPORTAR ARQUIVOS
 For i = 1 To 18
 WBgeral.Activate
 Sheets(Arquivo(i)).Activate
 Cells.Select
 Selection.Clear
 Workbooks.OpenXML ("C:\macrosm\prerelatoriolucimara\" & Arquivo(i) & ".xls")
 Range("A1").Select
 Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
 Selection.Copy
 WBgeral.Activate
 Sheets(Arquivo(i)).Activate
 ActiveSheet.Paste
 Workbooks(Arquivo(i)).Close SaveChanges:=False
 Next i
 'IMPORTAR ARQUIVOS
 Sheets("Principal").Activate
 For i = 1 To 18
 Sheets(Arquivo(i)).Visible = False
 Next i
 Cells(4, 16).Value = Date
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 Application.DisplayAlerts = True
 SaveChanges = True
End Sub

Answer 1

Recommendations

The less tasks that a subroutine performs the easier it is debug and modify. If I were to put this code into production (distribute it for general use) I would extract these functions from the main code:

• ApplicationState(PauseEvents): - handles the application state
• getWorksheetNames() - returns Arquivo(). This will allow you to tests whether the worksheets exists in the main workbook and whether the files exists without having to run the main code. This alone will reduce your main code from 49 lines to 31. I personally like to keep my subroutines no bigger than 25 - 30 lines whenever possible.
• getXMLWorkBook(FilePath) As Workbook - use Len(Dir(FilePath)) > 0 to test if the file exists, if so, open and return the workbook.

Next I would add error handlers to test if the workbook exists or if there are any missing worksheets.

Excel Do's and Don't

There are very few times where you'll need to Select or Activate an Object.

Watch: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)

There is no reason to use Application.DisplayAlerts = False in this code. Workbook.Close SaveChanges:=False does not display any alerts.

Range references should be fully qualified. If you are working with multiple workbooks, you should also qualify the worksheets to their parent workbook. It might take a little getting used to but fully qualifying your references will save you a ton of headaches. What usually happens is that you get the code working great and but later when you come back and to modify it you get unexpected results. This can be especially tough to resolve in a large project.

Refactored Code

Here is how I would refactor the code for in-house use.

Sub AtualizarRelatorioGeral()
 Const BasePath As String = "C:\macrosm\prerelatoriolucimara\FileName.xls"
 Dim wsName As Variant, wbName As String
 ApplicationState True
 For Each wsName In Array("zpp03ontem", "vl10a", "mb51consumomensal", "mb51repassegerado", "mb52peixerev", "mb52peixepro", "mb52exp", "mb52repassesaldo", "zsd17", "zsd25fat", "zsd25dev", "mc.9estoquecd", "mc.9consumo", "mc.9centro", "mc.9cdhipet", "mc.9valor", "zpp25", "mc.9produto")
 wbName = Replace(BasePath, "FileName", wsName)
 With Workbooks.OpenXML(wbName)
 ThisWorkbook.Worksheets(wsName).Cells.Clear
 .Worksheets(wsName).Cells.Copy ThisWorkbook.Worksheets(wsName).Range("A1")
 .Close SaveChanges:=False
 Next
 Next
 ThisWorkbook.Worksheets("Sheet1").Cells(4, 16).Value = Date
 ApplicationState False
End Sub
Sub ApplicationState(PauseEvents As Boolean)
 With Application
 .Calculation = IIf(PauseEvents, xlCalculationManual, xlCalculationAutomatic)
 .ScreenUpdating = Not PauseEvents
 .EnableEvents = Not PauseEvents
 End With
End Sub

• AJD: Nice use of Array and Replace. I didn't use UsedRange because the used range is not guaranteed to start at "A1" and this would displace the copy.
• TinMan: @AJD good point. I changed it from .UsedRange to .Cells.
• William Cezar: This is awesome. Going to study you code right now.
• Marcucciboy2: It might just be me, but I feel like the function name ApplicationState is kind of ambiguous. Unless you're reading the function declaration and can see the parameter's name, it (to me) seems counterintuitive. I would probably refactor it to ApplicationStatePause
• TinMan: ApplicationStatePause would be better for here. I think that ApplicationState made more sense in its original implementation where I saved and restored the settings. I'll have to give it some more thought. Thanks for your input.

Answer 2

Firstly, as a habit, always include "Option Explicit" at the top of every module. This would force you to declare WBgeral (as Workbook would be logical),

I assume that you originally created this from a recorded macro. Your use of .Select and Activate are, in this case, not necessary and would act to slow your routine down.

Why make the sheets visible, only to make them invisible again? This represents two loops that you can do without.

You also have a Cells action towards the end of the program that is not properly qualified - which worksheet are you changing, and why? I am assuming this is to put a date of import into your workbook.

You also active, select, copy and paste - where as you can simply overwrite the target cells with the source values. Activating and selecting reflect human activity - but VBA code don't need these. Removing these extraneous steps will give the following code.

Sub AtualizarRelatorioGeral()
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.DisplayAlerts = False
 SaveChanges = False
 Dim Arquivo(18) As String
 Arquivo(1) = "zpp03ontem"
 Arquivo(2) = "vl10a"
 Arquivo(3) = "mb51consumomensal"
 Arquivo(4) = "mb51repassegerado"
 Arquivo(5) = "mb52peixerev"
 Arquivo(6) = "mb52peixepro"
 Arquivo(7) = "mb52exp"
 Arquivo(8) = "mb52repassesaldo"
 Arquivo(9) = "zsd17"
 Arquivo(10) = "zsd25fat"
 Arquivo(11) = "zsd25dev"
 Arquivo(12) = "mc.9estoquecd"
 Arquivo(13) = "mc.9consumo"
 Arquivo(14) = "mc.9centro"
 Arquivo(15) = "mc.9cdhipet"
 Arquivo(16) = "mc.9valor"
 Arquivo(17) = "zpp25"
 Arquivo(18) = "mc.9produto"
 Dim WBGeral as Workbook
 Dim newWB as Workbook
 Set WBgeral = ActiveWorkbook 'Perhaps this should be "ThisWorkbook"?
 'IMPORTAR ARQUIVOS
 For i = 1 To 18
 WBgeral.Sheets(Arquivo(i)).Cells.Clear
 Set NewWB = Workbooks.OpenXML("C:\macrosm\prerelatoriolucimara\" & Arquivo(i) & ".xls")
 newWB.Sheets(1).Cells.Copy WBgeral.Sheets(Arquivo(i)).Cells
 newWB.Close SaveChanges:=False
 Next i
 'IMPORTAR ARQUIVOS
 WBgeral.Sheets("Principal").Cells(4, 16).Value = Date
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 Application.DisplayAlerts = True
 SaveChanges = True
End Sub

You don't have any error checking - what if the file does not open? What if the data is on a different sheet in there?

Also, why use OpenXML why you can just use Open as it is an .xls you are opening?

• TinMan: That looks a lot better then when I first looked at it...lol.
• AJD: @TinMan: LOL - had finger troubles and accidently saved when I hit <Tab>.