1/28/2019 excel - How to increase the execution speed of my VBA macro code?
- Stack Overflow
Make your voice heard. Take the 2019 Developer Survey now
How to increase the execution speed of my VBA Ask Question
macro code? [closed]
I am providing you with the code of
my macro and hope that somebody
1 can tell me what is making my macro
slow and provide me with a solution
as to how to make it run faster.
Currently the execution of this code is
taking ~ 1 min to finish but I still need
to improve the execution time, any
help will be highly appreciated. Below
is the code:
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim query As String
Dim Fond As String
Dim KontoNr As String
Dim StartDate As Date
Dim EndDate As Date
Dim wb As Workbook
Dim wr As Worksheet
Dim ws As Worksheet
Dim wt As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Set wb = ActiveWorkbook
Set wr = Sheets("Fee")
Set ws = Sheets("TestExecution")
Set wt = Sheets("Results_Overview")
'wr.UsedRange.Interior.ColorIndex = 0
With wr.UsedRange
RowCount = .Rows.Count
If (RowCount > 1) Then
wr.Range(2 & ":" & RowCount).EntireRow.Delete
End If
End With
With wt.UsedRange
RowCount = .Rows.Count
If (RowCount > 2) Then
wt.Range(2 & ":" & RowCount).EntireRow.Delete
https://stackoverflow.com/questions/47261539/how-to-increase-the-execution-speed-of-my-vba-macro-code 1/5
1/28/2019 excel - How to increase the execution speed of my VBA macro code? - Stack Overflow
End If
End With
With ws.UsedRange
ws.Range(Cells(2, 1), Cells(.Rows.Count, 1)).ClearContents
ws.Range(Cells(2, 6), Cells(.Rows.Count, 15)).ClearContents
End With
Dim r As Long
Dim Count As Integer
Dim a As Integer
Dim Counter As Integer
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
PeriodStartDate = ws.Cells(2, 4).Value
PeriodEndDate = ws.Cells(3, 4).Value
KontoNr = ws.Cells(4, 4).Value
Count = DatePart("d", PeriodEndDate)
strCon = "Provider=SQLOLEDB; " & _
"Data Source= XXX;" & _
"Initial Catalog=XX;" & _
"Integrated Security=SSPI"
con.Open (strCon)
query = "SELECT distinct Fond FROM RI_Trans_Akt ta WITH (NOLOCK) WHERE cast(ta.Avslutsdag
as date) < '" & PeriodEndDate & "'"
rs.Open query, con, adOpenStatic
con.Execute query
Counter = rs.RecordCount
ws.Cells(2, 1).CopyFromRecordset rs
rs.Close
con.Close
Dim p As Long
Dim lp As Long
For p = 2 To Counter + 1
StartDate = ws.Cells(2, 4).Value
a = wr.Range("A" & wr.Rows.Count).End(xlUp).Row
For r = 1 To Count
Fond = ws.Cells(p, 1).Value
wr.Cells(a + r, 1).Value = Fond
wr.Cells(a + r, 2).Value = StartDate
wt.Cells(a + r, 1).Value = Fond
wt.Cells(a + r, 2).Value = StartDate
DateFormat = Format(StartDate, "yyyymmdd")
con.Open (strCon)
query = "select Totalt_Antal_Andelar,Forvaltnings_avgift,CAST(Forvaltnings_avgift_kurs AS
NUMERIC(30,10)) AS Forvaltnings_avgift_Kurs from ri_fond_avgift WITH (NOLOCK) where Datum
= '" & StartDate & "' and Fond = '" & Fond & "'"
rs.Open query, con
con.Execute query
If (rs.RecordCount > 0) Then
wr.Cells(a + r, 3).Value = rs.Fields(0)
wr.Cells(a + r, 4).Value = rs.Fields(1)
wr.Cells(a + r, 5).Value = rs.Fields(2)
Else
wr.Cells(a + r, 3).Value = "0.00"
wr.Cells(a + r, 4).Value = "0.00"
wr.Cells(a + r, 5).Value = "0.00"
End If
https://stackoverflow.com/questions/47261539/how-to-increase-the-execution-speed-of-my-vba-macro-code 2/5
1/28/2019 excel - How to increase the execution speed of my VBA macro code? - Stack Overflow
rs.Close
query = "SELECT ta.KontoNr,Sum (Antal_andelar) FROM RI_Trans_Akt ta WITH (NOLOCK) WHERE
ta.Kontonr = '" & KontoNr & "' and cast(ta.Avslutsdag as date) < '" & StartDate & "' and
ta.Fond = '" & Fond & "' and ta.Mak_dag is null Group BY ta.Kontonr,ta.Fond"
rs.Open query, con, adOpenStatic
con.Execute query
If (rs.RecordCount > 0) Then
wr.Cells(a + r, 6).Value = rs.Fields(0)
wr.Cells(a + r, 7).Value = rs.Fields(1)
Else
wr.Cells(a + r, 7).Value = "0.00"
End If
rs.Close
con.Close
StartDate = DateAdd("d", 1, StartDate)
Next r
Dim i As Integer
For i = a + 1 To Count + a
If (wr.Cells(i, 3).Value <> 0) Then
wr.Cells(i, 8).Value = wr.Cells(i, 5).Value * wr.Cells(i, 7).Value
wt.Cells(i, 3).Value = wr.Cells(i, 8).Value
Else
wr.Cells(i, 5).Value = "0.00"
wr.Cells(i, 8).Value = "0.00"
wt.Cells(i, 3).Value = "0.00"
End If
Next i
Dim j As Integer
Dim totalManagementFee As Double
totalManagementFee = 0
For j = a + 1 To Count + a
totalManagementFee = totalManagementFee + wr.Cells(j, 8).Value
Next j
ws.Cells(p, 7).Value = totalManagementFee
ws.Cells(p, 6).Value = Fond
Next p
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
excel vba excel-vba
edited Nov 13 '17 at 12:07
Pᴇʜ
21.4k 4 27 50
asked Nov 13 '17 at 9:57
Rahul
5 5
closed as off-topic by Ralph, Pᴇʜ,
Scott Craner, YowE3K, Kostas K.
Nov 14 '17 at 7:23
https://stackoverflow.com/questions/47261539/how-to-increase-the-execution-speed-of-my-vba-macro-code 3/5
1/28/2019 excel - How to increase the execution speed of my VBA macro code? - Stack Overflow
o at 3
This question does not appear to
be about programming within the
scope defined in the help center.
If this question can be reworded to fit
the rules in the help center, please edit
the question.
6 I'm flagging this question as off-topic
because it should be migrated to
CodeReview as stipulated here:
meta.stackoverflow.com/questions/26
6749/… Reason: the code is working
and the OP himself / herself asks for
an improvement but not to overcome
an error or implement something new.
– Ralph Nov 13 '17 at 10:10
Hi,I have moved it to code review. –
Rahul Nov 13 '17 at 10:24
Done, you can see now – Rahul Nov
13 '17 at 11:22
2 You're doing a lot of reading and
writing back to the sheet which uses
up a lot of overhead. Have a look at
doing everything in memory i.e. in an
array and then writing the output to
the sheet in one hit. It'll be a lot
quicker – Tom Nov 13 '17 at 13:09
To optmize, try to use autofilter with an
array multi criteria and delete the rows
on a single task. Or if you don't want
to use filter, you can make a non
contiguous range and delete all at
once later. Because the most time
consuming action in your code, is
every time you perform actions on
your worksheet, in your case when
you delete. And refer to this, this and
this – danieltakeshi Nov 13 '17 at
13:26
1 Answer
ok, so you are reading and writing
from and to the range, you should do
0 this once and not in a loop. Also,
deleting rows one by one will take
much time and you don't need to do
this. Use arrays, convert a range to
an array first and then execute all of
your validations and manipulation etc
on the array first and once done, just
paste the array to the range.
to change a range to an array simply
do this:
https://stackoverflow.com/questions/47261539/how-to-increase-the-execution-speed-of-my-vba-macro-code 4/5
1/28/2019 excel - How to increase the execution speed of my VBA macro code? - Stack Overflow
Dim i, j As Long
Dim arr() As Variant
Dim rng As Range
Set rng = Worksheet.Range("A1:B10") 'd
arr = rng.Value
'access all cell values inside the arr
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(arr, 2)
'do whatever you want to do in
Next j
Next i
'paste back the new values to the rang
rng.Value = arr
also you are running the same query
twice with different functions: rs.Open
query, con, adOpenStatic 'returns a
recordset con.Execute query 'does
not return a recordset
delete the second line, you don't
need it
you are opening and closing the
same connection more than once,
whike you need to open the
connection once before executing
any of your SQL queries and close it
at the end of it.
con.open
' run all sql queries, no need to clos
purpose for it
con.close
set con=nothing
also instead of looping through a
recordset, dump your data in an array
and then loop through the array, it is a
lot faster and more stable:
array = recordset.GetRows(Rows, Start,
answered Nov 13 '17 at 20:21
Ibo
2,145 5 16 31
https://stackoverflow.com/questions/47261539/how-to-increase-the-execution-speed-of-my-vba-macro-code 5/5
