Is there a better code to do this?
 

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

Is there a better code to do this?
 

I am working in Range("D5:AK1760") and in this range there are sets of 2
columns side by side, one with dates and the other with status. If the date
is less than or equal to today and the cell,c.Offset(0,1)="Projected", change
the cell, c.Offset(0,1), to Past Due. That is all I am trying to do. The
problem is that I have to do it for each column with the date header and
there are about 17 columns.
"Jim Thomlinson" wrote:

Instead of looking at each cell in the range you could use the find function
to locate all of your cells that start with date. That will speed things up.
From your code it is hard to see exactly what you are intending to do.
Perhaps a quick descritions would help...
--
HTH...

Jim Thomlinson


"Ayo" wrote:

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

Is there a better code to do this?
 

Thanks Per. This works perfect; it took less than 30secs. Beautiful.

"Per Jessen" wrote:

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

Is there a better code to do this?
 

LastRow = Range("D" & Rows.Count).End(xlUp).Row
LastColumn = Cells(5, Columns.Count).End(xlToLeft).Column

For ColCount = 7 To LastColumn Step 2
For RowCount = 5 To LastRow
Status = Cells(RowCount, ColCount)
MyDate = Cells(RowCount, ColCount - 1)
If Status = "Projected" And _
MyDate <= Date Then
Cells(RowCount, ColCount) = "PastDue"
End If
Next RowCount
Next ColCount
"joel" wrote:

You can do the following

set MyRange = Range("A5:AK1757")

then use Range or colun again

Myrange.Range("A1") Really A5
or
MyRange.columns("A")

or

MyRange.Rows(1) really row 1


to get last column

MyRange(Columns.Count)

For the code to take 30 minutes you must be looping through the range
multiple times. Because you have two FOR loops it loos like you are looping
so you are going through each cell AxA times where A is the number of cell
in your range. I'm not sure what you are really trying to do.


"Ayo" wrote:

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

Is there a better code to do this?
 

Ο χÏ�ήστης "Ayo" Î*γγÏ�αψε:

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

This is an other way:

Option Explicit
Declare Function GetTickCount Lib "kernel32" () As Long

Sub FindAndReplace()
Dim rngFirstCol As Range
Dim rngCol As Range
Dim rngCell As Range
Dim lngRow As Long
Dim lngStart As Long

lngStart = GetTickCount
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

On Error Resume Next
Set rngFirstCol = Rows(5).Find("Status" _
, , , , xlByColumns).EntireColumn _
.SpecialCells(xlCellTypeConstants)
Set rngCol = rngFirstCol

If Not rngCol Is Nothing Then
Do
With rngCol
Set rngCell = .Find("Projected", , , , xlByRows)
If Not rngCell Is Nothing Then
Do
lngRow = rngCell.Row
If rngCell.Offset(, -1) <= Date Then
rngCell = "Past Due"
End If
Set rngCell = .FindNext(rngCell)
Loop While rngCell.Row lngRow
End If
End With
Set rngCol = Rows(5).Find("Status", rngCol(1) _
, , , xlByColumns).EntireColumn _
.SpecialCells(xlCellTypeConstants)
Loop While rngFirstCol.Column < rngCol.Column
End If

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
Debug.Print GetTickCount - lngStart & " msec"
End Sub

Supposal:
"Status" is the caption of the header of all status columns.