robertlevine
Registered User.
- Local time
- Today, 13:51
- Joined
- Oct 8, 2003
- Messages
- 24
I have written a macro in Excel that pulls data in from an Access table - but it's running INDRECIBLY slowly. Could someone please take a look and see if they can help me speed it up?
All I am trying to do is pull data from an Access table and insert it on a worksheet.
Sub LoadPLDMY()
Dim ssCnt%
Dim RowNumPldmy%
Const gDebugMode% = True
Dim sht As Worksheet
Dim sql$
Dim db As Database
Dim ss As Recordset
Dim errmsg$
Dim xx%
Dim time1$
Dim time2$
RowNumPldmy% = 0
If Not gDebugMode% Then On Error GoTo LoadPLDMY_Error
errmsg$ = ""
Set db = DBEngine.OpenDatabase("k:\PLDATA.MDB", , True)
Set sht = ThisWorkbook.Worksheets("PLDMY")
sht.Range("PLDMYData").ClearContents
sql$ = "SELECT portfolio, hedge, security, usd_day_pl, mtd_usd_pl, ytd_usd_pl, position, "
sql$ = sql$ & " price, prev_price, pnldate "
sql$ = sql$ & " FROM pldmy "
Set ss = db.OpenRecordset(sql$, dbOpenSnapshot)
If ss.EOF Then
errmsg$ = "No data found."
GoTo LoadPLDMY_Exit
End If
ss.MoveLast
ss.MoveFirst
ssCnt% = ss.RecordCount
time1$ = Time
For xx% = 1 To ssCnt%
RowNumPldmy% = RowNumPldmy% + 1
With sht.Range("PLDMYData")
If RowNumPldmy% <= .Rows.Count Then
.Cells(RowNumPldmy%, 1) = ss!portfolio
.Cells(RowNumPldmy%, 2) = ss!hedge
.Cells(RowNumPldmy%, 3) = ss!security
.Cells(RowNumPldmy%, 4) = ss!usd_day_pl
.Cells(RowNumPldmy%, 5) = ss!mtd_usd_pl
.Cells(RowNumPldmy%, 6) = ss!ytd_usd_pl
.Cells(RowNumPldmy%, 7) = ss!Position
.Cells(RowNumPldmy%, 8) = ss!price
.Cells(RowNumPldmy%, 9) = ss!prev_price
.Cells(RowNumPldmy%, 10) = ss!pnldate
Else
errmsg$ = "Not enough room to place PLDMY data."
GoTo LoadPLDMY_Exit
End If
End With
ss.MoveNext
Next
time2$ = Time
LoadPLDMY_Exit:
On Error Resume Next
ss.Close
Set ss = Nothing
db.Close
Set db = Nothing
If errmsg$ <> "" Then
MsgBox errmsg$, vbCritical
End If
Exit Sub
LoadPLDMY_Error:
errmsg$ = Err.Description
Resume LoadPLDMY_Exit
End Sub
All I am trying to do is pull data from an Access table and insert it on a worksheet.
Sub LoadPLDMY()
Dim ssCnt%
Dim RowNumPldmy%
Const gDebugMode% = True
Dim sht As Worksheet
Dim sql$
Dim db As Database
Dim ss As Recordset
Dim errmsg$
Dim xx%
Dim time1$
Dim time2$
RowNumPldmy% = 0
If Not gDebugMode% Then On Error GoTo LoadPLDMY_Error
errmsg$ = ""
Set db = DBEngine.OpenDatabase("k:\PLDATA.MDB", , True)
Set sht = ThisWorkbook.Worksheets("PLDMY")
sht.Range("PLDMYData").ClearContents
sql$ = "SELECT portfolio, hedge, security, usd_day_pl, mtd_usd_pl, ytd_usd_pl, position, "
sql$ = sql$ & " price, prev_price, pnldate "
sql$ = sql$ & " FROM pldmy "
Set ss = db.OpenRecordset(sql$, dbOpenSnapshot)
If ss.EOF Then
errmsg$ = "No data found."
GoTo LoadPLDMY_Exit
End If
ss.MoveLast
ss.MoveFirst
ssCnt% = ss.RecordCount
time1$ = Time
For xx% = 1 To ssCnt%
RowNumPldmy% = RowNumPldmy% + 1
With sht.Range("PLDMYData")
If RowNumPldmy% <= .Rows.Count Then
.Cells(RowNumPldmy%, 1) = ss!portfolio
.Cells(RowNumPldmy%, 2) = ss!hedge
.Cells(RowNumPldmy%, 3) = ss!security
.Cells(RowNumPldmy%, 4) = ss!usd_day_pl
.Cells(RowNumPldmy%, 5) = ss!mtd_usd_pl
.Cells(RowNumPldmy%, 6) = ss!ytd_usd_pl
.Cells(RowNumPldmy%, 7) = ss!Position
.Cells(RowNumPldmy%, 8) = ss!price
.Cells(RowNumPldmy%, 9) = ss!prev_price
.Cells(RowNumPldmy%, 10) = ss!pnldate
Else
errmsg$ = "Not enough room to place PLDMY data."
GoTo LoadPLDMY_Exit
End If
End With
ss.MoveNext
Next
time2$ = Time
LoadPLDMY_Exit:
On Error Resume Next
ss.Close
Set ss = Nothing
db.Close
Set db = Nothing
If errmsg$ <> "" Then
MsgBox errmsg$, vbCritical
End If
Exit Sub
LoadPLDMY_Error:
errmsg$ = Err.Description
Resume LoadPLDMY_Exit
End Sub