Speed issues with running large spreadsheets and processing macros

tomleitch

Board Regular
Joined
Jan 3, 2012
Messages
189
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
 
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:

Code:
        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:

Code:
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
 
Upvote 0

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
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


VBA Code:
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,223,353
Messages
6,171,604
Members
452,411
Latest member
sprichwort

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top