Speed up VBA Code 5

[romeerome368]

Hello,

I have created code to help me write large amounts of data to an Excel 2010 file. The code works great, but it's working slower than what I would like. It ran for 2 hours and only posted 40,000 records which is way to slow for my fast paced environment.

I have a recordset that has 618,000 rows of data, but it's slow going with writing the data to the spreadsheet.

Below is what my code looks like:

    Dim appExcel As Object
    Dim i As Integer
    Dim lngCount, lngCurrentRow, lngRows, n As Long
    Dim rng, rngData, rngStart As Excel.Range
    Dim strDataRange, strSheetName, strStartAddress As String
    Dim strTemplate, strTemplateFile, strTitle, strSaveName As String
    Dim strFilePath, strPrompt As String
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    
    strFilePath = "C:\Documents and Settings\. . .\"
    strTemplate = "Rolling13PdOutput.xltx"
    strTemplateFile = strFilePath & strTemplate
    
    Set appExcel = CreateObject("Excel.Application")
    Set dbs = CurrentDb
    
    Set rst = dbs.OpenRecordset("qryRolling13PdOutput")
    
    Set wkb = appExcel.Workbooks.Add(strTemplateFile)
        Set wks = wkb.Sheets(1)
        wks.Activate
        appExcel.Visible = True
        
        Set rngStart = wks.Range("A2")
        Set rng = wks.Range("A2")
        
        rst.MoveLast
        rst.MoveFirst
        lngCount = rst.RecordCount
    
        For n = 1 To lngCount
        
            rng.Value = Nz(rst![PC]) 'A
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Regions]) 'B
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Areas]) 'C
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Branch]) 'D
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Segment]) 'E
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Class]) 'F
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Total Dollars]) 'G
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![YEAR]) 'H
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![PERIOD]) 'I
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Total Volume]) 'J
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![# of Services]) 'K
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Chain Code]) 'L
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Material]) 'M
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Customer ID]) 'N
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Customer Name]) 'O
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Street1]) 'P
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![City]) 'Q
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![State]) 'R
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Zip Code]) 'S
            Set rng = rng.Offset(Columnoffset:=1)
            rng.Value = Nz(rst![Phone]) 'T

            rst.MoveNext
            Set rng = rngStart.Offset(RowOffset:=n)
        Next n
        
        lngRows = wks.UsedRange.Rows.Count
        strRange = "A2:AD" & CStr(lngRows)
        Set rngData = wks.Range(strRange)
        
        strSheetName = "All customer info - " & Format(Date, "yymmdd")
        strSaveName = strFilePath & strSheetName & ".xlsx"
        
        wkb.SaveAs FileName:=strSaveName, FileFormat:=xlWorkbookDefault
        wkb.Close
        rst.Close
        
        strTitle = "Workbook Created"
        strPrompt = strSheetName & vbCrLf & "was created in " _
            & strFilePath
        MsgBox strPrompt, vbOKOnly + vbInformation, strTitle
End Sub

Is there a way to speed this code up? The commented letters represent the column letters in my spreadsheet template.

Anyone's help is greatly appreciated.

 

[Deniall]

Before you start filling cells, use:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Then after you have finished filling, reverse these with
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

 

[strongm]

Change your Dims as well - many of your variables are being declared as variants, which subsequent performance hit.

For example, this line

Dim lngCount, lngCurrentRow, lngRows, n As Long

is not doing what you think it is. If you do not declare an explicit type for a variable then VBA gives it the default type, a variant, even if the last variable in the same line has an explicit type (a different behaviour from that in the venerable QuickBASIC or QBasic). So in the line above you have managed to declare lngCount, lngCurrentRow and lngRows as variants.

 

[macropod]

I suspect too that all the range setting inside the loop is causing a performance hit. Try something along the lines of:

Dim i As Long
With Rng
  For i = 1 To lngCount
    .Offset(i, 1).Value = Nz(rst![PC]) 'A
    .Offset(i, 2).Value = Nz(rst![Regions]) 'B
    .Offset(i, 3).Value = Nz(rst![Areas]) 'C
    .Offset(i, 4).Value = Nz(rst![Branch]) 'D
    .Offset(i, 5).Value = Nz(rst![Segment]) 'E
    .Offset(i, 6).Value = Nz(rst![Class]) 'F
    .Offset(i, 7).Value = Nz(rst![Total Dollars]) 'G
    .Offset(i, 8).Value = Nz(rst![Year]) 'H
    .Offset(i, 9).Value = Nz(rst![Period]) 'I
    .Offset(i, 10).Value = Nz(rst![Total Volume]) 'J
    .Offset(i, 11).Value = Nz(rst![# of Services]) 'K
    .Offset(i, 12).Value = Nz(rst![Chain Code]) 'L
    .Offset(i, 13).Value = Nz(rst![Material]) 'M
    .Offset(i, 14).Value = Nz(rst![Customer ID]) 'N
    .Offset(i, 15).Value = Nz(rst![Customer Name]) 'O
    .Offset(i, 16).Value = Nz(rst![Street1]) 'P
    .Offset(i, 17).Value = Nz(rst![City]) 'Q
    .Offset(i, 18).Value = Nz(rst![State]) 'R
    .Offset(i, 19).Value = Nz(rst![Zip Code]) 'S
    .Offset(i, 20).Value = Nz(rst![Phone]) 'T
    rst.MoveNext
  Next i
End With

Cheers
Paul Edstein
[MS MVP - Word]

 

[SkipVought]

you don't have any logic within your loop. So why not just assign the entire recordset, using the CopyFromRecordset method.

    Set rst = dbs.OpenRecordset("qryRolling13PdOutput")
    
    Set wkb = appExcel.Workbooks.Add(strTemplateFile)
    Set wks = wkb.Sheets(1)
    wks.Activate
    appExcel.Visible = True
        
    OnError resume next

    rst.MoveFirst

    if err.number = 0 then 
       wks.Range("A2").COpyFromRecordset rst
    else
       err.clear
       'and what else if there are no rows returned???
 
    end if

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[romeerome368]

Hello Deniall, marcopod, and Skip,

Thanks for your outstanding assistance. I can't wait until I'm as good as you guys are.

It was a nightmare trying to copy and paste data of that size in bits and pieces. I have several applications where I can use each of your advise. Deniall and macropod, I'm using your advise in a report that I create in Excel when data is being dropped from several recordsets, but not all of the the data is being dropped into Excel. Skip, I'm using your suggestion in my mass download from Access to Excel.

You guys are awesome. Keep up the great work. Hopefully, I will be able to join you guys as MVP's one day soon.

Again, thank you all!!!!

 

[romeerome368]

Oh I left strongm out, I'm sorry I didn't put you in my original post. I didn't know that Access would make the other variables into variants. I thought that it was a shortcut so that I wouldn't have to Dim every single varible. I took your advise, and made sure that I gave each variable a single declaration instead of trying to group the variables.

Thank you so much for your assistance. You're awesome too!!

 

[Andrzejek]

Just FYI, instead of:

Dim lngCount, lngCurrentRow, lngRows, n As Long

You can either do:

Dim lngCount As Long, lngCurrentRow As Long, lngRows As Long, n As Long

or - and that's my prefered way:

Dim lngCount As Long
Dim lngCurrentRow As Long
Dim lngRows As Long
Dim n As Long

Why? I use MZTools to find all unused variables, and this way it works the best.

So - how fast is youe app now?

Have fun.

---- Andy

 

[romeerome368]

Thanks Andy,

It went from several hours to about 5 to 10 minutes. It was great to discover those suggestions. I work in a highly visible, high pressure position to provide executive reporting.

Going forward I will defintely use your suggestions, because it allows me to save space, and do exactly what I need.

 

[kjv1611]

Wow, one macro running for hours? that must've been PAINFUL.

Don't forget to cleanup any objects, arrays, and such as the end. For instance, at first glance, I'd say you need these lines at the end of your code, just before End Sub:

    If Not rng Is Nothing Then Set rng = Nothing
    If Not rngStart Is Nothing Then Set rngStart = Nothing
    If Not wks Is Nothing Then Set wks = Nothing
    If Not appExcel Is Nothing Then Set appExcel = Nothing

    If dbs Is Nothing Then
    Else
       dbs.Close
       Set dbs = Nothing
    End If

Of course, if there are any of those variables you've decided to do without, then you won't need to close/clear them either.

That part may not speed up the current process very much, but it'll clean up any objects floating in memory at the end. For instance, since you're using an Application Object instance of Excel, if you don't explicitly kill the object variable, if you look in your task manager after running this a few times, you may end up seeing a few extra Excel instances under the Processes tab.

 

[kjv1611]

And for reference, might I suggest you post your cleaned up code for comparison? Perhaps it'll help someone else along the way.

 

[romeerome368]

Thanks kjv1611!!

It was painful because my Director and VP were looking at me with disgust in their eyes. I had never missed a report before, and it was like they were testing me to see how much I could handle, and when I gave them their report 4 hours prior to their deadline the frowns turned upside down. I then had my golden halo again.

I always make sure I do that at the end of all of my code just because I know that windows has issues with memory allocations.

I'll post the code as a solution for dropping large amounts of data from Access to Excel 2007 and 2010. I know that there are people who could definitely use it.

 

[strongm]

>it'll clean up any objects floating in memory at the end

So will simply exiting the procedure

 

[xlbo]

>So will simply exiting the procedure

you'd like to think so wouldn't you!

Issue comes more with global variables which should definitely be set to nothing unless they need to be re-used as the same object reference and it has been suggested that especially when automating MS Excel form other apps, not setting the XL application object to nothing can cause the XL instance to hang around in task manager like a bad smell

For local variables there is no need although for complicated procedures I tend to still do so really to keep track of what objects are being used where...

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[kjv1611]

I've always read that is supposed to be the case with VBA which makes it easier to program in than say C++ - no worries about closing out objects in memory.

However, in some of my tests, I've seen Application objects remain in memory (easy to see by simply looking at processes in Task Manager) after the very workbook running them was closed... and any calling VBA script had since ended.

The instances I had for this, though, were specifically run from Access VBA, calling Excel. If Excel wasn't closed manually or programatically by the callign procedure, even if the procedure exited, I'd end up with a few extra Excel processes showing in the task manager. So I guess it's not just closing them, but actually killing the application (quit) if you opened an application instance.

But to each his/her own. I'll stick with doing my own cleanup to play it safe.

 

[kjv1611]

Oh, another piece to that, as well, may be when you run an application instance, but that instance is not visible to the user. Because if it's visible to the user, they'll eventually close the application anyway.

 

[SkipVought]

Excel 2010 Performance: Tips for Optimizing Performance Obstructions



Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]