GetValue + loop = Can it go faster? - vba

Question

I have created main file which imports data from other (closed) excel files. There is x-ten of files from which I need to import data. I made a code in UserForm so that mine boss can choose where to import (sheet = wariant) file. It is not completed because I need to add options button (for choosing which file to import), but main core will look like beneath.
But there is a problem, in our company we have a medium class laptops, so that code (beneath) in executin in 5-7 minutes for each file (wariant). I need it to run as fast as possible. Can you make something with it?
Private Sub CommandButton1_Click()
StartTime = Timer
Dim p As String
Dim f As String
Dim s As String
Dim a As String
Dim r As Long
Dim c As Long
Dim Warinat As String
If UserForm1.War1 = True Then Wariant = "Wariant 1"
If UserForm1.War2 = True Then Wariant = "Wariant 2"
If UserForm1.War3 = True Then Wariant = "Wariant 3"
If UserForm1.War4 = True Then Wariant = "Wariant 4"
p = ThisWorkbook.path
f = "files.xlsx"
s = "Sheet1"
Application.ScreenUpdating = False
For r = 7 To 137
For c = 2 To 96
a = Cells(r, c).Address
If IsNumeric(Cells(r, c)) = True And ThisWorkbook.Sheets(Wariant).Cells(r, c) <> "" _
Then ThisWorkbook.Sheets(Wariant).Cells(r, c) = _
ThisWorkbook.Sheets(Wariant).Cells(r, c).Value + GetValue(p, f, s, a)
Else
ThisWorkbook.Sheets(Wariant).Cells(r, c) = GetValue(p, f, s, a)
End If
Next c
Next r
EndTime = Timer
MsgBox Format(EndTime - StartTime, ssss)
Unload Me
End Sub
Private Function GetValue(path, file, sheet, ref)
Dim arg As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "Files is missing"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_Click()
End Sub

Answer 1

Your ExecuteExcel4Macro call is likely slowing down the process, as it opens the same workbook 12,445 times. You're dealing with two 2-D arrays; one in your Wariant sheet and one in your imported workbook. Try something like this.
Dim var1 As Variant
Dim var2 As Variant
Dim wbImport As Workbook
'Set var1 as your range value
var1 = ThisWorkbook.Sheets(Wariant).Range("B7:CR137").Value
'Open the Import workbook, set the value, then close it.
Set wbImport = Application.Workbooks.Open(p & f)
var2 = wbImport.Sheets("Sheet1").Range("B7:CR137").Value
wbImport.Close
'Now loop through the variant arrays - much faster
For r = 1 To 131
For c = 1 To 95
If IsNumeric(var1(r, c)) And var1(r, c) <> "" Then
var1(r, c) = _
var1(r, c) + var2(r, c)
Else
var1(r, c) = var2(r, c)
End If
Next c
Next r
'Finally, copy the variant array back into the workbook.
ThisWorkbook.Sheets(Wariant).Range("B7:CR137").Value = var1

Answer 2

It will probably run faster if you open each workbook rather than reading cell-by-cell from a closed workbook.

Answer 3

not without knowing what you are calling with ExecuteExcel4Macro function, because called macro can be anything and very likely is reason why your code excecutes slowly
GetValue = ExecuteExcel4Macro(arg)

Answer 4

To do this without opening the workbook you can paste this code into a new module:
Dim v As Variant
Function GetValues(p As String, f As String, s As String, a As String)
v = Empty
Application.ExecuteExcel4Macro "'" & ThisWorkbook.Name & "'!SetV('" & p & "\[" & f & "]" & s & "'!" & a & ")"
GetValues = v
End Function
Public Function SetV(Value)
v = Value
End Function
You can then retrieve all the values from the closed workbook in a single call like this:
GetValues(ThisWorkbook.path,"files.xlsx","Sheet1","r7c2:r137c96")