Speed issues with running large spreadsheets and processing macros

[tomleitch]

Hi all,

General question here - just looking for pointers or suggestions really.

I have a fairly large spreadsheet - currently around 20,000 rows and 60 columns.

When this spreadsheet is run it runs very slowly on company laptops

It has macros in it that do quite a lot of things - some process data etc. I need these to be available when using the spreadsheet (i.e. excel online is no good for me).

Are there any solutions that I could look at in general to speed things up?

Is it possible to have some calculations etc that macros are doing running remotely maybe, or something like that?

Using filters on the spreadsheet is also very very slow.... but the macros are the main one that take the time.

I have the files hosted on a MS sharepoint site.


Any pointers or advice much appreciated.


Thanks
Tom

 

[RoryA]

Also at the end you colour and write data to blocks of cells that are next to each other, one by one. You can do those in one go too. So rather than this:

        ws1.Range("E" & NxtRw).Value = .Item(Ky)(4)
        ws1.Range("E" & NxtRw).Interior.Color = rgbYellow
         ws1.Range("F" & NxtRw).Value = .Item(Ky)(3)
         ws1.Range("F" & NxtRw).Interior.Color = rgbYellow
        ws1.Range("G" & NxtRw).Value = .Item(Ky)(9)
        ws1.Range("G" & NxtRw).Interior.Color = rgbYellow
        ws1.Range("H" & NxtRw).Value = .Item(Ky)(2)
        ws1.Range("H" & NxtRw).Interior.Color = rgbYellow
        ws1.Range("I" & NxtRw).Value = .Item(Ky)(1)
        ws1.Range("I" & NxtRw).Interior.Color = rgbYellow

you can do this:

With ws1.Range("E" & NxtRw).Resize(, 5) ' E:I is 5 cells
    .Interior.Color = rgbYellow
    .Value = Array(.Item(Ky)(4), .Item(Ky)(3), .Item(Ky)(9), .Item(Ky)(2), .Item(Ky)(1))
End With

 

[tomleitch]

RoryA, thanks again - sounds like another good idea.

Really appreciate your help - I'm pretty new to all this and it's being really helpful understanding where the big bottlenecks are in my code.

The part that you last mentioned is how the code handles new line items (that don't already exist).... however I think (not 100% sure) that the bit that takes it the longest to process is when the items do already exist, but their values are different (it might just be because there is more changes made by that than the new items).

So the below is the part that I think is causing the majority of the slow running time. Could you give any kind of pointers for any areas you think I could tweak to make it run faster?

Thanks
Tom

For Each cl In ws1.Range("A10", ws1.Range("A" & Rows.count).End(xlUp))
      
     
            If .exists(cl.Value) Then
            
            
            
            'Check update Scheduler Comments to column A

            
            
85              If .Item(cl.Value)(14) <> "" Then

                If cl.Comment Is Nothing Then cl.AddComment
                
                If cl.Comment.Text <> .Item(cl.Value)(14) Then
               
                On Error Resume Next
86
                On Error GoTo 90
                 Cells(cl.Row, 1).Comment.Text Text:=.Item(cl.Value)(14)
                 Cells(cl.Row, 1).Comment.Shape.TextFrame.AutoSize = True
               If Cells(cl.Row, 1).Comment.Shape.Width > 200 Then
                     Cells(cl.Row, 1).Comment.Shape.Width = 200
                     Cells(cl.Row, 1).Comment.Shape.Height = 60
                     End If
                  End If
              End If
            
        
                'Check/update Desc and add location as comment
87                If Trim(UCase(cl.Offset(, 1).Value)) <> Trim(UCase(.Item(cl.Value)(0))) Then
                cl.Offset(, 1).Value = .Item(cl.Value)(0)
                
                    If .Item(cl.Value)(6) <> "" Then
                    If cl.Offset(, 1).Comment Is Nothing Then cl.Offset(, 1).AddComment
                    cl.Offset(, 1).Comment.Text Text:=.Item(cl.Value)(6)
                    cl.Offset(, 1).Comment.Shape.TextFrame.AutoSize = True
                        If cl.Offset(, 1).Comment.Shape.Width > 200 Then
                        cl.Offset(, 1).Comment.Shape.Width = 200
                        cl.Offset(, 1).Comment.Shape.Height = 60
                        End If
                    End If
                    cl.Offset(, 1).Interior.Color = rgbYellow
                End If
            
                'Check/Update Lead craft
                    If Trim(UCase(cl.Offset(, 8).Value)) <> Trim(UCase(.Item(cl.Value)(1))) Then
                    cl.Offset(, 8).Value = .Item(cl.Value)(1)
                    cl.Offset(, 8).Interior.Color = rgbYellow
                End If
            
            '   Check/Update CFW
                    If Trim(UCase(cl.Offset(, 7).Value)) <> Trim(UCase(.Item(cl.Value)(2))) Then
                    cl.Offset(, 7).Value = .Item(cl.Value)(2)
                    cl.Offset(, 7).Interior.Color = rgbYellow
                End If
            
            '   Check/Update Status
                    If Trim(UCase(cl.Offset(, 5).Value)) <> Trim(UCase(.Item(cl.Value)(3))) Then
                    cl.Offset(, 5).Value = .Item(cl.Value)(3)
                    cl.Offset(, 5).Interior.Color = rgbYellow
                End If
            
            'Check/Update priority
                    If Trim(UCase(cl.Offset(, 4).Value)) <> Trim(UCase(.Item(cl.Value)(4))) Then
                    cl.Offset(, 4).Value = .Item(cl.Value)(4)
                    cl.Offset(, 4).Interior.Color = rgbYellow
                End If
            
            
            ' Update Sched Start
                    If CLng(cl.Offset(, 12).Value) <> CLng(.Item(cl.Value)(5)) Then
                        If .Item(cl.Value)(5) <> "" Then
                        If cl.Offset(, 12).Comment Is Nothing Then cl.Offset(, 12).AddComment
                        cl.Offset(, 12).Comment.Text Text:="Last date: " & cl.Offset(, 12).Value
                        cl.Offset(, 12).Comment.Shape.TextFrame.AutoSize = True
                        If cl.Offset(, 12).Comment.Shape.Width > 200 Then
                        cl.Offset(, 12).Comment.Shape.Width = 200
                        cl.Offset(, 12).Comment.Shape.Height = 60
                    End If
                    End If
                    cl.Offset(, 12).Value = .Item(cl.Value)(5)
                    cl.Offset(, 12).Interior.Color = rgbYellow
                End If
  
  
            ' Update Parent ID
                    If Trim(UCase(cl.Offset(, 3).Value)) <> Trim(UCase(.Item(cl.Value)(7))) Then
                    cl.Offset(, 3).Value = .Item(cl.Value)(7)
                       If .Item(cl.Value)(8) <> "" Then
                        If cl.Offset(, 3).Comment Is Nothing Then cl.Offset(, 3).AddComment
                        cl.Offset(, 3).Comment.Text Text:=.Item(cl.Value)(8)
                        cl.Offset(, 3).Comment.Shape.TextFrame.AutoSize = True
                            If cl.Offset(, 3).Comment.Shape.Width > 200 Then
                            cl.Offset(, 3).Comment.Shape.Width = 200
                            cl.Offset(, 3).Comment.Shape.Height = 60
                        End If
                    End If
                    cl.Offset(, 3).Interior.Color = rgbYellow
                End If
     
     
            'Check/Update CAP Status
                    If Trim(UCase(cl.Offset(, 6).Value)) <> Trim(UCase(.Item(cl.Value)(9))) Then
                    cl.Offset(, 6).Value = .Item(cl.Value)(9)
                    cl.Offset(, 6).Interior.Color = rgbYellow
                End If
            
             'Check/Update SCE Status
                    If .Item(cl.Value)(10) = "Y" Then
                ''''''''''''''''''
                If .Item(cl.Value)(15) <> "" Then
                If cl.Offset(, 9).Comment Is Nothing Then cl.Offset(, 9).AddComment
47                If cl.Offset(, 9).Comment.Text <> .Item(cl.Value)(15) Then
48                        cl.Offset(, 9).Comment.Text Text:="Target Finish: " & .Item(cl.Value)(15)
49                        cl.Offset(, 9).Comment.Shape.TextFrame.AutoSize = True
50                            If cl.Offset(, 9).Comment.Shape.Width > 200 Then
                            cl.Offset(, 9).Comment.Shape.Width = 200
                            cl.Offset(, 9).Comment.Shape.Height = 60
                        End If
                  ''''''''''''''''
                    End If
                    End If
                    End If

                    
                    If Trim(UCase(cl.Offset(, 9).Value)) <> Trim(UCase(.Item(cl.Value)(10))) Then
                    cl.Offset(, 9).Value = .Item(cl.Value)(10)
                    cl.Offset(, 9).Interior.Color = rgbYellow
                End If
                
                'Check/Update Hours
                
                 If Trim(UCase(cl.Offset(, 14).Value)) <> Trim(UCase(.Item(cl.Value)(13))) Then
                    cl.Offset(, 14).Value = .Item(cl.Value)(13)
                    cl.Offset(, 14).Interior.Color = rgbYellow
                End If

 

[RoryA]

Much the same idea really. You're testing multiple cells on the same row, so read the entire row into an array (as I did in my first example) then use the values in that array (reading/updating as necessary) and write them back to the row when done. Also, anywhere you have repeated code calls, like .Item(cl.Value), it's inefficient. Not only are you retrieving the same value from your Dictionary repeatedly, you're reading a cell value each time to do so. Instead, store .Item(cl.Value) in a variable and use that directly.

 

[tomleitch]

That's great. Thanks. Just the kind of steer I was hoping for. Lots of food for thought.