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