VBA code required

[Damo10]

Hi,

I am looking for some code that will go through all the rows starting at cell E20 and execute the code that I have written if it meets the criteria then move to the next row until it finds the last populated row then move to the next column and repeat, it would then do this until it finds the last populated column.

There are currently 1100 rows and 70 columns in my sheet and need each cell to be checked.

Hope someone can help

Regards Damian

 

[Boller]

What are the criteria and what do you want to do if the criteria are met?

 

[Damo10]

if the cell contains "a" and the date in the corrosponding cell in column C is the same or less than the current date change the cell content to a "h"

 

[Boller]

Dim rng As Range, startCell As Range
Dim celAddress$, cel As Range, x#
Set rng = Range([E20], Cells(Rows.Count, Columns.Count))
Set startCell = rng.Cells(1)
Do
    Set cel = rng.Find(What:="a", After:=startCell, _
        LookIn:=xlValues, LookAt:=xlWhole)
    If cel Is Nothing Then Exit Do
    If x = 0 Then
        celAddress = cel.Address
        x = 1
    Else
        If cel.Address = celAddress Then Exit Do
        If Cells(cel.Row, "C") <= Date Then cel = "h"
    End If
    Set startCell = cel
Loop

 

[Damo10]

Thanks that worked great

 

[Damo10]

Hi,

I have been testing this code and have found that it always misses the first cell, is there anyway to rectify this?

 

[Boller]

Dim rng As Range, startCell As Range
Dim celAddress$, cel As Range, x#
Set rng = Range([E20], Cells(Rows.Count, Columns.Count))
Set startCell = rng.Cells(1)
Do
    Set cel = rng.Find(What:="a", After:=startCell, _
        LookIn:=xlValues, LookAt:=xlWhole)
    If cel Is Nothing Then Exit Do
    If Cells(cel.Row, "C") <= Date Then cel = "h"
    If x = 0 Then
        celAddress = cel.Address
        x = 1
    Else
        If cel.Address = celAddress Then Exit Do
    End If
    Set startCell = cel
Loop

 

[Damo10]

Hi,

I tried this and it does not change any of the cell contents

Regards

 

[Boller]

Dim rng As Range, startCell As Range, rng2 As Range
Dim celAddress$, cel As Range, x#
Set rng = Range([E20], Cells(Rows.Count, Columns.Count))
Set startCell = rng.Cells(1)
Do
    Set cel = rng.Find(What:="a", After:=startCell, _
        LookIn:=xlValues, LookAt:=xlWhole)
    If cel Is Nothing Then Exit Do
    If x = 0 Then
        celAddress = cel.Address
        If Cells(cel.Row, "C") <= Date Then Set rng2 = cel
        x = 1
    Else
        If cel.Address = celAddress Then Exit Do
        If Cells(cel.Row, "C") <= Date Then Set rng2 = Union(cel, rng2)
    End If
    Set startCell = cel
Loop
rng2 = "h"

 

[Damo10]

Hi,

Just tried this code and it is giving a run time error 91 with the line rng2 = "h"

Regards