Tips on how to speed up a macro

[288enzo]

I know there are a lot of hardware variables on how fast it will run. It takes me approximately 1 min for 1,000 rows and there are a little over 10,000 rows.

Is there anything I can do to speed it up?

Thank you.

Sub Compare_Dates()
    Dim rng As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim rng4 As Range
    Dim LastRow As Long
    Dim i As Long
    Dim x As Long
    Dim sq, sp, Start, Last As Variant
    Dim sh As Worksheet
    
    Start = InputBox("Starting Row?")
    Last = InputBox("Ending Row? (Last Row = 0")
    
    Dim StartTime   As Double
    Dim MinutesElapsed As String
    StartTime = Timer
    
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name Like "KPI Data*" Then sq = sh.Name
        If sh.Name Like "CR*" Then sp = sh.Name
    Next
    
    Sheets(sp).Select
    
    Range("A1:B" & Range("A" & Rows.Count).End(xlUp).Row).Copy
    
    Sheets(sq).Select
    
    Range("AL1").PasteSpecial
    
    LastRow = Cells(Rows.Count, "X").End(xlUp).Row
    
    If Last = 0 Then
        Last = LastRow
    End If
    
    Set rng2 = Range("AL2:AL" & Range("AL" & Rows.Count).End(xlUp).Row)
    Set rng3 = Range("AM2:AM" & Range("AL" & Rows.Count).End(xlUp).Row)
   
    For x = Start To Last
            
        If Range("W" & x) > 10 And Range("X" & x) > 1 Then
        
            For i = 1 To Range("X" & x)
                Columns("Z:Z").NumberFormat = "m/d/yyyy"
                Range("Z" & i).FormulaArray = "=INDEX(" & rng3.Address & ", SMALL(IF((" & Range("G" & x).Address & "=" & rng2.Address & "), MATCH(ROW(" & rng2.Address & "), ROW(" & rng2.Address & ")), """"),ROWS($A$1:A" & i & ")))"
                Range("AA" & i) = Range("Z" & i) - Range("N" & x)
                
            Next i
            Set rng4 = Range("AA1:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
            
            Range("Y" & x).FormulaArray = "=INDEX(" & rng4.Address & ",MATCH(MIN(ABS(" & rng4.Address & "-0)),ABS(" & rng4.Address & "-0),0))"
        End If
        
        Range("Y" & x).Copy
        Range("Y" & x).PasteSpecial Paste:=xlPasteValues
        Columns("Z:AA").Clear
        
    Next x
    
    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
    MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
    
End Sub

 

[288enzo]

I added the below which cut the time down to around 30 seconds. Much better. If anyone else has some tips, please share. Thank you.

    With Application
    .ScreenUpdating = False
    .DisplayStatusBar = False
    .EnableEvents = False
    End With

 

[pijan11]

I added the below which cut the time down to around 30 seconds. Much better. If anyone else has some tips, please share. Thank you.

    With Application
    .ScreenUpdating = False
    .DisplayStatusBar = False
    .EnableEvents = False
    End With

How do I add this speed up code to this one (I'm new to VBA, sorry ?)

Private Sub Worksheet_Calculate()
       Dim c As Range     
    Application.EnableEvents = False
        For Each c In Range("A11:A110") 
                    If c.Value = "" Then
                Rows(c.Row & ":" & c.Row).EntireRow.Hidden = True
            Else
                Range(c.Row & ":" & c.Row).EntireRow.Hidden = False
            End If
        Next

    Application.EnableEvents = True

End Sub

 

[Alex Blakenburg]

How do I add this speed up code to this one (I'm new to VBA, sorry ?)

You are nearly there already. ScreenUpdating is the one that is likely to have the biggest impact for you.

Private Sub Worksheet_Calculate()
    Dim c As Range
    
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With
    
    For Each c In Range("A11:A110")
        If c.Value = "" Then
            Rows(c.Row & ":" & c.Row).EntireRow.Hidden = True
        Else
            Range(c.Row & ":" & c.Row).EntireRow.Hidden = False
        End If
    Next
    
    With Application
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With

End Sub

 

[Alex Blakenburg]

I added the below which cut the time down to around 30 seconds. Much better. If anyone else has some tips, please share. Thank you.

I don't know if you got back to this but I don't understand your inner loop "For i = 1 To Range("X" & x)"
eg
1) Columns("Z:Z").NumberFormat = "m/d/yyyy"
This only needst to be done at the end and putting it inside a loop adds no value at all.

2) The next 2 statements rely on x but the output relies on i, so it seems to me that the output cells are only going to contain the value based on the last x.
So why loop through x.
But without sample data I can't be sure.

 

[pijan11]

You are nearly there already. ScreenUpdating is the one that is likely to have the biggest impact for you.

Private Sub Worksheet_Calculate()
    Dim c As Range
   
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With
   
    For Each c In Range("A11:A110")
        If c.Value = "" Then
            Rows(c.Row & ":" & c.Row).EntireRow.Hidden = True
        Else
            Range(c.Row & ":" & c.Row).EntireRow.Hidden = False
        End If
    Next
   
    With Application
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With

End Sub

Thanks. I tried it but it didn't fix the speed for me.

 

[Alex Blakenburg]

Thanks. I tried it but it didn't fix the speed for me.

You really need to start your own separate thread. It runs fairly quickly as far as I can tell so you will to need to give more of an explanation of what issues you are having.

 

[pijan11]

You really need to start your own separate thread. It runs fairly quickly as far as I can tell so you will to need to give more of an explanation of what issues you are having.

I did, but i didn't get any feedback from anybody.

Excel running slow

Hello, I'm new to VBA and I need some help with speed being slow when inputing data into my file (sorry for my data being in French). When I input data in the Fields entitled "École", "Année scolaire", i can't do anything for about 4 seconds. When I input data into the field "Nombre...

www.mrexcel.com

 

[Fluff]

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.
Thread closed.