Speed of writing a 2D dictionary on first run slow

[KillGorack]

Hi,

I have a macro that just grabs data from one sheet, does a little formatting, and places that data into another..

In the attachment the first column is the time it takes to read the data into a 2D dictionary, and the second column is the time it takes to place it into ThisWorkbook

the code below is the portion where it's written.

Runs slow as heck the first time, and quickly after.. I think it's a cache thing, but don't know how to get around it.

Any ideas on how to speed this up on first use?

        s = Timer()
        xcursor = 2
        For Each pkey In topics.Keys
            ycursor = 1
            For Each ckey In topics(pkey)
                If ckey = 0 Then
                    ThisWorkbook.Sheets("Data").Range("A" & xcursor & ":T" & xcursor).Interior.ColorIndex = topics(pkey)(ckey)
                Else
                    ThisWorkbook.Sheets("Data").Cells(xcursor, ycursor - 1).value = topics(pkey)(ckey)
                End If
                ycursor = ycursor + 1
            Next ckey
            xcursor = xcursor + 1
        Next pkey
        timertempheight = ThisWorkbook.Sheets("Timer").Cells(Rows.Count, 2).End(xlUp).Row
        ThisWorkbook.Sheets("Timer").Cells(timertempheight + 1, 2).value = Timer() - s

 

[KillGorack]

I "think" we're on to something... I usually run this sub before and after each complicated task...

I added the "Application.Cursor" line after noticing when I have my cursor NOT over excel it runs faster..

So far it rings true.. very weird..

Function calcEvents(state As Boolean)

    If state = True Then
    
        Application.EnableEvents = True
        Application.Calculation = xlAutomatic
        Application.ScreenUpdating = True
        Application.DisplayStatusBar = True
        ThisWorkbook.Sheets("data").DisplayPageBreaks = True
        Application.Cursor = xlDefault
        
    ElseIf state = False Then
    
        Application.EnableEvents = False
        Application.Calculation = xlManual
        Application.ScreenUpdating = False
        Application.DisplayStatusBar = False
        ThisWorkbook.Sheets("data").DisplayPageBreaks = False
        Application.Cursor = xlNorthwestArrow
        
    End If

End Function

 

[offthelip]

You code is slow becaue you are writing to the worksheet every iteration inside a double loop, this is always going to be slow. To speed it up you need to write the value out to a variant array and then write the array out at the end. Unfortunatly formatting does invovle writing to the worksheet. So you do need to do that.
What is the range of the workhseet that you are operating this on, is it constant? Something like this:

xmax = 300
ymax = 40
inarr = ThisWorkbook.Sheets("Data").Range(Cells(1, 1), Cells(xmax, ymax))
      s = Timer()
        xcursor = 2
        For Each pkey In topics.Keys
            ycursor = 1
            For Each ckey In topics(pkey)
                If ckey = 0 Then
                    ThisWorkbook.Sheets("Data").Range("A" & xcursor & ":T" & xcursor).Interior.ColorIndex = topics(pkey)(ckey)
                Else
'                    ThisWorkbook.Sheets("Data").Cells(xcursor, ycursor - 1).Value = topics(pkey)(ckey)
                    inarr(xcursor, ycursor - 1) = topics(pkey)(ckey)
                End If
                ycursor = ycursor + 1
            Next ckey
            xcursor = xcursor + 1
        Next pkey
     
ThisWorkbook.Sheets("Data").Range(Cells(1, 1), Cells(xmax, ymax)) = inarr
        timertempheight = ThisWorkbook.Sheets("Timer").Cells(Rows.Count, 2).End(xlUp).Row
        ThisWorkbook.Sheets("Timer").Cells(timertempheight + 1, 2).Value = Timer() - s

 

[KillGorack]

Variant arrays.. I'll read.. thanks

 

[KillGorack]

You code is slow becaue you are writing to the worksheet every iteration inside a double loop, this is always going to be slow. To speed it up you need to write the value out to a variant array and then write the array out at the end. Unfortunatly formatting does invovle writing to the worksheet. So you do need to do that.
What is the range of the workhseet that you are operating this on, is it constant? Something like this:

xmax = 300
ymax = 40
inarr = ThisWorkbook.Sheets("Data").Range(Cells(1, 1), Cells(xmax, ymax))
      s = Timer()
        xcursor = 2
        For Each pkey In topics.Keys
            ycursor = 1
            For Each ckey In topics(pkey)
                If ckey = 0 Then
                    ThisWorkbook.Sheets("Data").Range("A" & xcursor & ":T" & xcursor).Interior.ColorIndex = topics(pkey)(ckey)
                Else
'                    ThisWorkbook.Sheets("Data").Cells(xcursor, ycursor - 1).Value = topics(pkey)(ckey)
                    inarr(xcursor, ycursor - 1) = topics(pkey)(ckey)
                End If
                ycursor = ycursor + 1
            Next ckey
            xcursor = xcursor + 1
        Next pkey
    
ThisWorkbook.Sheets("Data").Range(Cells(1, 1), Cells(xmax, ymax)) = inarr
        timertempheight = ThisWorkbook.Sheets("Timer").Cells(Rows.Count, 2).End(xlUp).Row
        ThisWorkbook.Sheets("Timer").Cells(timertempheight + 1, 2).Value = Timer() - s

with constant height not so much but I can get that size from the dictionary.. I will try this, and use it going forward with the nested arrays.. I'll report back. Thanks!

 

[KillGorack]

You code is slow becaue you are writing to the worksheet every iteration inside a double loop, this is always going to be slow. To speed it up you need to write the value out to a variant array and then write the array out at the end. Unfortunatly formatting does invovle writing to the worksheet. So you do need to do that.
What is the range of the workhseet that you are operating this on, is it constant? Something like this:

xmax = 300
ymax = 40
inarr = ThisWorkbook.Sheets("Data").Range(Cells(1, 1), Cells(xmax, ymax))
      s = Timer()
        xcursor = 2
        For Each pkey In topics.Keys
            ycursor = 1
            For Each ckey In topics(pkey)
                If ckey = 0 Then
                    ThisWorkbook.Sheets("Data").Range("A" & xcursor & ":T" & xcursor).Interior.ColorIndex = topics(pkey)(ckey)
                Else
'                    ThisWorkbook.Sheets("Data").Cells(xcursor, ycursor - 1).Value = topics(pkey)(ckey)
                    inarr(xcursor, ycursor - 1) = topics(pkey)(ckey)
                End If
                ycursor = ycursor + 1
            Next ckey
            xcursor = xcursor + 1
        Next pkey
    
ThisWorkbook.Sheets("Data").Range(Cells(1, 1), Cells(xmax, ymax)) = inarr
        timertempheight = ThisWorkbook.Sheets("Timer").Cells(Rows.Count, 2).End(xlUp).Row
        ThisWorkbook.Sheets("Timer").Cells(timertempheight + 1, 2).Value = Timer() - s

This is something I'll add to my arsenal going forward, between the cursor graphic slowing this down, and the loop fix you've provided..

Thanks again.

 

[KillGorack]

code if you're interested...

        xmax = topics.Count + 1
        ymax = 20
        With ThisWorkbook.Sheets("Data")
            inarr = .Range(.Cells(1, 1), .Cells(xmax, ymax))
            s = Timer()
            xcursor = 2
            For Each pkey In topics.Keys
                ycursor = 1
                For Each ckey In topics(pkey)
                    If ckey = 0 Then
                        .Range("A" & xcursor & ":T" & xcursor).Interior.ColorIndex = topics(pkey)(ckey)
                    Else
                        inarr(xcursor, ycursor - 1) = topics(pkey)(ckey)
                    End If
                    ycursor = ycursor + 1
                Next ckey
                xcursor = xcursor + 1
            Next pkey
            .Range(.Cells(1, 1), .Cells(xmax, ymax)) = inarr
        End With
        timertempheight = ThisWorkbook.Sheets("Timer").Cells(Rows.Count, 2).End(xlUp).Row
        ThisWorkbook.Sheets("Timer").Cells(timertempheight + 1, 2).value = Timer() - s

 

[offthelip]

In my experience the sort of improvement you have got from 35 seconds to less than a second is typical of what can be achieved by using variant arrays instead of looping through cells in a range, and usually it is very easy to do!! As per your solution.
I very rarely bother about turning calculation and screenupdate off because doing it all in a varinat array it doesn't update the worksheet, so no calculations or screen updates. In your case becasue you are updating the formatting it will make a difference