The below code changes the font to strikethrough when there are no values in
ColumnC in the rows of 2-22 offset from a value in ColumnA.

The code seems to work ok, but seems to be dependant on the LAST value
rather than ALL the values.

Sub RemoveUsedRolls()
Application.ScreenUpdating = False
Dim LastCell As Long
Dim myrow As Long
On Error Resume Next
LastCell = Worksheets("InspectionData").Cells(Rows.Count, "A").End(xlUp).Row
With ActiveWorkbook.Worksheets("InspectionData")
For myrow = 2 To LastCell ' <======= Seems to change value in Column A font
ONLY by what LAST Cell font is like
If .Cells(myrow, 1) < "" Then
For i = 2 To 22 ' <=============== Need the font changed when there is NO
values in this range with Font.Strikethrough = False
If .Cells(myrow, 3).Offset(i, 0).Value < "" And .Cells(myrow, 3).Offset(i,
0).Font.Strikethrough = False Then
If .Cells(myrow, 1).Value < "" Then .Cells(myrow, 1).Font.Strikethrough =
False
Else:
If .Cells(myrow, 3).Offset(i, 0).Value < "" And .Cells(myrow, 3).Offset(i,
0).Font.Strikethrough = True Then
If .Cells(myrow, 1).Value < "" Then .Cells(myrow, 1).Font.Strikethrough =
True
End If
End If
Next i
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Did i miss something to in include ALL values in the Indicated lines ??
Corey....

Any takers at all ????
Sure it is a small thing i have missed but cannot work it out.

"Corey" wrote in message
...
The below code changes the font to strikethrough when there are no values
in ColumnC in the rows of 2-22 offset from a value in ColumnA.

The code seems to work ok, but seems to be dependant on the LAST value
rather than ALL the values.

Sub RemoveUsedRolls()
Application.ScreenUpdating = False
Dim LastCell As Long
Dim myrow As Long
On Error Resume Next
LastCell = Worksheets("InspectionData").Cells(Rows.Count,
"A").End(xlUp).Row
With ActiveWorkbook.Worksheets("InspectionData")
For myrow = 2 To LastCell ' <======= Seems to change value in Column A
font ONLY by what LAST Cell font is like
If .Cells(myrow, 1) < "" Then
For i = 2 To 22 ' <=============== Need the font changed when there is NO
values in this range with Font.Strikethrough = False
If .Cells(myrow, 3).Offset(i, 0).Value < "" And .Cells(myrow,
3).Offset(i, 0).Font.Strikethrough = False Then
If .Cells(myrow, 1).Value < "" Then .Cells(myrow, 1).Font.Strikethrough =
False
Else:
If .Cells(myrow, 3).Offset(i, 0).Value < "" And .Cells(myrow,
3).Offset(i, 0).Font.Strikethrough = True Then
If .Cells(myrow, 1).Value < "" Then .Cells(myrow, 1).Font.Strikethrough =
True
End If
End If
Next i
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Did i miss something to in include ALL values in the Indicated lines ??
Corey....

Corey,

My simplification of your code is listed below. You need to clarify what you
are trying to do. Currently it doesn't seem to be logical. What it does
according to my interpretation is:

1. Iterates through the cells in column A starting at A2 down to the end of
data.
2. For each nonblank cell it finds in column A (call this the current cell)
it loops through all the cells in column C starting 2 rows below the current
cell and ranging to 22 rows below the current cell.
3. Each time it finds a nonblank cell in column C during this loop it
changes the strikethrough format of the current cell to that of the cell in
column C.
4. So the current cell's strikethrough format alternates as a function of
what is found in column C during the loop.
5. And the current cell's strikethrough format will end up just being the
same as the last nonblank cell it finds in column C in the range 2 to 22 rows
below the current cell.
6. Then it goes to the next nonblank cell in column A and repeats. So,
unless there is a 22 cell gap between each nonblank cell in column A, the
range in column C that is checked for strikethrough will overlap.

That's my $0.02 worth.

Regards,
Greg

Sub RemoveUsedRolls2()
Dim ws As Worksheet
Dim c As Range
Dim LastRw As Long
Dim myrow As Long

Set ws = Sheets("InspectionData")
On Error Resume Next
LastRw = ws.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For myrow = 2 To LastRw
Set c = ws.Cells(myrow, 1)
If c.Value < "" Then
For i = 2 To 22
With ws.Cells(myrow + i, 3)
If .Value < "" Then
c.Font.Strikethrough = .Font.Strikethrough
End If
Next i
End If
Next
Application.ScreenUpdating = True
On Error GoTo 0
End Sub

Greg,
Thank you for the reply.
Unless i got lost in my Cut/Paste code what i want to happen is:

1. Iterates through the cells in column A starting at A2 down to the end of
data. ~~ CORRECT~~
2. For each nonblank cell it finds in column A (call this the current
cell)
it loops through all the cells in column C starting 2 rows below the
current
cell and ranging to 22 rows below the current cell. ~~CORRECT~~
3. Each time it finds a nonblank cell in column C during this loop it
changes the strikethrough format of the current cell to that of the cell in
column C. ~~NO, If a Cell is NOT blank AND there is NO values
without Strikethrough, then the (current cell) in Column A is change to
strikethrough. ~~~
4. So the current cell's strikethrough format alternates as a function of
what is found in column C during the loop. ~~ CORRECT ~~
5. And the current cell's strikethrough format will end up just being the
same as the last nonblank cell it finds in column C in the range 2 to 22
rows
below the current cell. ~~NOT SUPPOSE TO~~~
6. Then it goes to the next nonblank cell in column A and repeats. So,
unless there is a 22 cell gap between each nonblank cell in column A, the
range in column C that is checked for strikethrough will overlap.
~~~~~ There is a Gap of 25 Rows between A Values~~~~~~

Any idea's

Corey....

"Greg Wilson" wrote in message
...
Corey,

My simplification of your code is listed below. You need to clarify what
you
are trying to do. Currently it doesn't seem to be logical. What it does
according to my interpretation is:

1. Iterates through the cells in column A starting at A2 down to the end
of
data.
2. For each nonblank cell it finds in column A (call this the current
cell)
it loops through all the cells in column C starting 2 rows below the
current
cell and ranging to 22 rows below the current cell.
3. Each time it finds a nonblank cell in column C during this loop it
changes the strikethrough format of the current cell to that of the cell
in
column C.
4. So the current cell's strikethrough format alternates as a function of
what is found in column C during the loop.
5. And the current cell's strikethrough format will end up just being the
same as the last nonblank cell it finds in column C in the range 2 to 22
rows
below the current cell.
6. Then it goes to the next nonblank cell in column A and repeats. So,
unless there is a 22 cell gap between each nonblank cell in column A, the
range in column C that is checked for strikethrough will overlap.

That's my $0.02 worth.

Regards,
Greg

Sub RemoveUsedRolls2()
Dim ws As Worksheet
Dim c As Range
Dim LastRw As Long
Dim myrow As Long

Set ws = Sheets("InspectionData")
On Error Resume Next
LastRw = ws.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For myrow = 2 To LastRw
Set c = ws.Cells(myrow, 1)
If c.Value < "" Then
For i = 2 To 22
With ws.Cells(myrow + i, 3)
If .Value < "" Then
c.Font.Strikethrough = .Font.Strikethrough
End If
Next i
End If
Next
Application.ScreenUpdating = True
On Error GoTo 0
End Sub

Corey,

Sorry but I took a break for dinner. My read is that you only want the cells
in column A to be strikethrough if there are NO values in column C in the
range 2 to 22 rows below that are normal format - i.e. ALL nonblank values in
column C are strikethrough in the range 2 to 22 rows below.

Note that if there is a performance issue (i.e. there are a lot of data)
then this can be made faster using the SpecialCells method. If not, it's very
simple and should do fine.

Sub RemoveUsedRolls2()
Dim ws As Worksheet
Dim c As Range
Dim LastRw As Long, myrow As Long, i As Long
Dim NormFontFound As Boolean

Set ws = Sheets("InspectionData")
LastRw = ws.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For myrow = 2 To LastRw
NormFontFound = False
Set c = ws.Cells(myrow, 1)
If c.Value < "" Then
For i = 2 To 22
With ws.Cells(myrow + i, 3)
If .Value < "" And .Font.Strikethrough = False Then
NormFontFound = True
Exit For
End If
End With
Next i
c.Font.Strikethrough = Not NormFontFound
End If
Next
Application.ScreenUpdating = True
End Sub

Regards,
Greg

Thank You.
Your works Perfectly.

Cheers


Corey....

"Greg Wilson" wrote in message
...
Corey,

Sorry but I took a break for dinner. My read is that you only want the
cells
in column A to be strikethrough if there are NO values in column C in the
range 2 to 22 rows below that are normal format - i.e. ALL nonblank values
in
column C are strikethrough in the range 2 to 22 rows below.

Note that if there is a performance issue (i.e. there are a lot of data)
then this can be made faster using the SpecialCells method. If not, it's
very
simple and should do fine.

Sub RemoveUsedRolls2()
Dim ws As Worksheet
Dim c As Range
Dim LastRw As Long, myrow As Long, i As Long
Dim NormFontFound As Boolean

Set ws = Sheets("InspectionData")
LastRw = ws.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For myrow = 2 To LastRw
NormFontFound = False
Set c = ws.Cells(myrow, 1)
If c.Value < "" Then
For i = 2 To 22
With ws.Cells(myrow + i, 3)
If .Value < "" And .Font.Strikethrough = False Then
NormFontFound = True
Exit For
End If
End With
Next i
c.Font.Strikethrough = Not NormFontFound
End If
Next
Application.ScreenUpdating = True
End Sub

Regards,
Greg

Minor correction. I had an End If instead of an End With:-

Sub RemoveUsedRolls2()
Dim ws As Worksheet
Dim c As Range
Dim LastRw As Long, myrow As Long, i As Long

Set ws = Sheets("InspectionData")
LastRw = ws.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For myrow = 2 To LastRw
Set c = ws.Cells(myrow, 1)
If c.Value < "" Then
For i = 2 To 22
With ws.Cells(myrow + i, 3)
If .Value < "" Then _
c.Font.Strikethrough = .Font.Strikethrough
End With
Next i
End If
Next
Application.ScreenUpdating = True
End Sub

Greg,
Please have a look at my previous thread.

"Greg Wilson" wrote in message
...
Minor correction. I had an End If instead of an End With:-

Sub RemoveUsedRolls2()
Dim ws As Worksheet
Dim c As Range
Dim LastRw As Long, myrow As Long, i As Long

Set ws = Sheets("InspectionData")
LastRw = ws.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For myrow = 2 To LastRw
Set c = ws.Cells(myrow, 1)
If c.Value < "" Then
For i = 2 To 22
With ws.Cells(myrow + i, 3)
If .Value < "" Then _
c.Font.Strikethrough = .Font.Strikethrough
End With
Next i
End If
Next
Application.ScreenUpdating = True
End Sub