Need code to run faster

[User Name Active]

I have a very long code that does exactly what I need it to do, except it takes 25 seconds to run. I have narrowed it down to the following two sections of code that are slowing it down. Can anyone help me on how to make these run faster?

First Section:

lastrow = Sheets("Crew Log").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Sheets("Crew Log").Range("L2:L" & lastrow)
        If rng <> "" Then
            Sheets("Storage").Range("A2:K2").Copy Sheets("Crew Log").Cells(rng.Row, 1)
            Sheets("Storage").Range("BM2:DQ2").Copy Sheets("Crew Log").Range("BM:DQ").Cells(rng.Row, 1)
         
        End If
    Next rng

Second Section:

Sheets("Summary").Unprotect "password"
 With Sheets("Summary")
    .Rows(42).Copy .Rows(43).Resize(Sheets("Restructure").Range("G1"))
End With
 Application.CutCopyMode = False

 

[Eric W]

That is a great link, and it's nice that so many performance improving tips are in one place. However, it leaves off one of the biggest tips I know. To wit: avoid reading the spreadsheet, writing to the spreadsheet, selecting ranges, selecting pages, copying ranges, pasting ranges, etc. All of those are time intensive. And usually there are ways around doing things that way. If you have to read something from the spreadsheet, read it all at one time, not a cell at a time. The same with writing.

For example, I populated my sheet with 2500 rows of data, then ran the "First section" code on it. It took about 28 seconds, similar to the time the OP mentioned. Then I added the

Application.ScreenUpdating = False

and it ran in 23 seconds. Reducing the time by 18%, fairly significant.

Then I rewrote the code like this:

Sub temp2()
Dim r As Long, c As Long, MyRange As Variant, LastRow As Long, rng1 As Variant


    LastRow = Sheets("Crew Log").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    MyRange = Sheets("Crew Log").Range("A1:DQ" & LastRow).Value
    rng1 = Sheets("Storage").Range("A2:DQ2")
    
    For r = 2 To LastRow
        If MyRange(r, 12) <> "" Then
            For c = 1 To 11
                MyRange(r, c) = rng1(1, c)
            Next c
            For c = 65 To 121
                MyRange(r, c) = rng1(1, c)
            Next c
        End If
    Next r
    
    Range("A1:DQ" & LastRow).Value = MyRange
    
End Sub

and it ran in less than 1/3 of a second. There are some drawbacks. You need enough memory to hold the range you're looking at. Plus I'm only moving values. The .Copy from the original code moves formatting as well. But depending on the ultimate goal, this is another real significant way to improve performance.