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 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
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
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
1 Answer 1
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.
.Rangeproperty 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. \$\endgroup\$