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.
Is there anything I can do to speed it up?
Thank you.
VBA Code:
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