# Increase the execution speed of VBA macro code

I am providing you with the code of my macro and hope that somebody 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 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
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

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 & "'"
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
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"
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

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

• You can Dim an array first, and do all the calculation in that array, after all processes are done, write them into worksheet at once. – newacc2240 Nov 13 '17 at 12:22
• Accessing the .Range property of the worksheet is expensive, especially in a loop. Same with deleting rows. It would be best to learn arrays and format your data in an array (thus, in-memory), clear the worksheet once, and then output the array to the sheet in one call. – Brandon Barney Nov 13 '17 at 13:03
• What task does this code accomplish? Please tell us. See How to Ask. – 200_success Nov 13 '17 at 13:32

After having a short look at your code, I get the impression that your database accesses in a double loop are the cause of the long execution time.

First of all, it is generally much faster to pull all necessary data from a database in one go into memory and to assign the specific points of data to their correct place later.

Moreover, to make optimal use of the database engine, you have to be cautious with conditions. Casting on a database column inside a condition, generally eliminates the possibility to use an index for fast access. Thus, most likely you will get a full table scan. Accordingly, you might want to think about how to change your date condition to eliminate the cast.

The next thing I observe is that you close and reopen the database connection in the loop. Establishung connections is rather expensive. So, you should open it once, reuse it and then close it at the end of your procedure.

Talking about the connection, you seem to execute all queries twice. There is no need to first open a record set and then execute the query again throwing the result away. You can simply set the result to the record set without opening it. Set rs = con.Execute(query)

Now, let me give some more remarks nit concerning performance.

Your code could really benefit from proper indentation. With it how deep your queries are in the loops would be immediately apparent.

Another thing that might be good for anybody maintaining the code would be to split it into several procedures and functions clearly separating the different jobs performed in this large procedure. With good names, this can help readibility a long way.

There are probably a few more things but I will leave it at this.