Hello!
I currently have a button that exports a query, customized by the user on the form, to excel. The data that is exported is compared to older values (from a history table) and depending on the changes, the cellcolor is changed, so I need to format each cell individually. I have it working, but with many columns and more than 2500 records it can take like 15 minutes to export. Here's what I do:
Is there a faster/more efficient way to do this? Any other tips are welcome since this is the first time I'm trying something like this.
Thanks!
I currently have a button that exports a query, customized by the user on the form, to excel. The data that is exported is compared to older values (from a history table) and depending on the changes, the cellcolor is changed, so I need to format each cell individually. I have it working, but with many columns and more than 2500 records it can take like 15 minutes to export. Here's what I do:
Code:
'fill in data in excel cells
intI = 2
Do While Not rsCurLL.EOF()
intCellCnt = 1
For Each fd In rsCurLL.Fields
'get the IDLine of the current record
If intCurIDLine <> rsCurLL.Fields("IDLine").Value Then
intCurIDLine = rsCurLL.Fields("IDLine").Value
'move the rsOldLL pointer to the matching record
rsOldLL.FindFirst ("[IDLine] = " & intCurIDLine & "")
If rsOldLL.NoMatch Then
blnIDLineNotFound = True
Else
blnIDLineNotFound = False
End If
End If
'if the "Deleted" field is not in teh view query it will not be exported
If fd.Name = "Deleted" Then
If varDeleted > 0 Then
xlSheet.Cells(intI, intCellCnt).Value = rsCurLL.Fields(fd.Name).Value
xlSheet.Cells(intI, intCellCnt).HorizontalAlignment = xlLeft
xlSheet.Cells(intI, intCellCnt).BorderAround xlContinuous
'if the current line is not present in the linelist_issued table, the line is new, so empty the old value
If blnIDLineNotFound = False Then
strFValueOld = Nz(rsOldLL.Fields(fd.Name).Value)
Else
strFValueOld = ""
End If
strFValueNew = Nz(rsCurLL.Fields(fd.Name).Value)
If strFValueNew <> strFValueOld Then
xlSheet.Cells(intI, intCellCnt).Interior.Color = RGB(192, 192, 192)
End If
If rsCurLL.Fields("Deleted").Value = True Then
xlSheet.Cells(intI, intCellCnt).Interior.Color = RGB(153, 204, 255)
End If
intCellCnt = intCellCnt + 1
End If
'if the "IDLine" field is not in the view query it will not be exported
ElseIf fd.Name = "IDLine" Then
If varIDLine > 0 Then
xlSheet.Cells(intI, intCellCnt).Value = rsCurLL.Fields(fd.Name).Value
xlSheet.Cells(intI, intCellCnt).HorizontalAlignment = xlLeft
xlSheet.Cells(intI, intCellCnt).BorderAround xlContinuous
If blnIDLineNotFound = False Then
strFValueOld = Nz(rsOldLL.Fields(fd.Name).Value)
Else
strFValueOld = ""
End If
strFValueNew = Nz(rsCurLL.Fields(fd.Name).Value)
If strFValueNew <> strFValueOld Then
xlSheet.Cells(intI, intCellCnt).Interior.Color = RGB(192, 192, 192)
End If
If rsCurLL.Fields("Deleted").Value = True Then
xlSheet.Cells(intI, intCellCnt).Interior.Color = RGB(153, 204, 255)
End If
intCellCnt = intCellCnt + 1
End If
ElseIf fd.Name = "revision" Then
'do nothing
Else
xlSheet.Cells(intI, intCellCnt).Value = rsCurLL.Fields(fd.Name).Value
xlSheet.Cells(intI, intCellCnt).HorizontalAlignment = xlLeft
xlSheet.Cells(intI, intCellCnt).BorderAround xlContinuous
If blnIDLineNotFound = False Then
strFValueOld = Nz(rsOldLL.Fields(fd.Name).Value)
Else
strFValueOld = ""
End If
strFValueNew = Nz(rsCurLL.Fields(fd.Name).Value)
If strFValueNew <> strFValueOld Then
xlSheet.Cells(intI, intCellCnt).Interior.Color = RGB(192, 192, 192)
End If
If rsCurLL.Fields("Deleted").Value = True Then
xlSheet.Cells(intI, intCellCnt).Interior.Color = RGB(153, 204, 255)
End If
intCellCnt = intCellCnt + 1
End If
Next
'display the current record
intCurRecord = intCurRecord + 1
lblCountCur.Caption = intCurRecord
Forms("MainMenuNew").Repaint
'move to next record
rsCurLL.MoveNext
intI = intI + 1
Loop
Thanks!
Comment