Hi

You can turn off screenupdating and set calculation to manual, and finally
skip the select statement.

Sub aaa()
Dim TargetRange As Range
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For Each ProgressHdr In rngProgresshdr.Cells
proPos = InStr(1, ProgressHdr.Address(ColumnAbsolute:=False), "$",
vbTextCompare)
ProgressLastColumn = Left(ProgressHdr.Address(ColumnAbsolute:=False),
proPos - 1)
If Right(ProgressHdr.Value, 4) = "Date" Then
Set TargetRange = ActiveSheet.Range(ProgressLastColumn & "5:" &
ProgressLastColumn & progresslastRow)
For Each c In TargetRange
If c.Value <= Date And c.Offset(0, 1).Value = "Projected" Then
c.Offset(0, 1).Value = "Past Due"
End If
Next
End If
Next ProgressHdr
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Hopes this helps.

---
Per

"Ayo" skrev i meddelelsen
...
I am trying to do a Find and Replace in Range("A5:AK1757") and I have the
following code to do it but it is just taking too long, more than 30
minutes.
IS there a better way to do this faster?
Thanks

For Each progresshdr In rngProgresshdr.Cells
proPos = InStr(1, progresshdr.Address(ColumnAbsolute:=False), "$",
vbTextCompare)
progresslastColumn = Left(progresshdr.Address(ColumnAbsolute:=False),
proPos - 1)

If Right(progresshdr.Value, 4) = "Date" Then
ActiveSheet.Range(progresslastColumn & "5:" & progresslastColumn &
progresslastRow).Select
For Each c In Selection
If c.Value <= Date And c.Offset(0, 1).Value = "Projected" Then
c.Offset(0, 1).Value = "Past Due"
End If
Next
End If
Next progresshdr