Coloring rows through value in column

[BartD]

Hi everyone,

Im currently trying to do the following in Excel 2016;
See attachment for more details

- Im trying to create a macro wich makes every row red that has the value 'Yes' in the column with overdue
- I cant use conditional formatting as i will send the macro acros multiple departments with different sheets
- If relevent, the column overdue is on column AP and the data starts at AP2 (AP1 is the header)
- The file does not have a set length. It can be 500 rows long, but a week later it can be 2000 rows long.

20210

Thank you all very much for looking into this!
Ive already tried a lot but nothing seems to work as I am new to VBA

Greetings,
Bart

[mdmackillop]

Option Explicit

Sub Overdue()
Dim col, r
Set r = ActiveSheet.UsedRange
With r
col = .Rows(1).Find("Overdue").Column
.Columns(col).AutoFilter field:=1, Criteria1:="Yes"
.Offset(1).SpecialCells(2).EntireRow.Interior.ColorIndex = 3
.Columns(col).AutoFilter
.Columns(col).AutoFilter field:=1, Criteria1:="No"
.Offset(1).SpecialCells(2).EntireRow.Interior.ColorIndex = xlNone
.Columns(col).AutoFilter
End With
End Sub

[Kenneth Hobs]

Welcome to the forum! Always test code on a backup copy first.

To set all, I would manually do an autofilter and select Yes and set the interior color. Or, try playing mdmackillop's macro from a Module.

To update automatically as column AP values change one at a time, right click the sheet tab, View Code, and paste.

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Column <> 42 Then Exit Sub '42=column AP
If .Cells.Count <> 1 Then Exit Sub
If .Row = 1 Then Exit Sub

Select Case .Value2
Case "Yes"
Rows(.Row).EntireRow.Interior.Color = vbRed
Case Else
Rows(.Row).EntireRow.Interior.Color = xlNone
End Select
End With
End Sub

Obviously, if AP values are by formula, the Change event would need some modification depending on the formula and its dependent cells.

[BartD]

Option Explicit

Sub Overdue()
Dim col, r
Set r = ActiveSheet.UsedRange
With r
col = .Rows(1).Find("Overdue").Column
.Columns(col).AutoFilter field:=1, Criteria1:="Yes"
.Offset(1).SpecialCells(2).EntireRow.Interior.ColorIndex = 3
.Columns(col).AutoFilter
.Columns(col).AutoFilter field:=1, Criteria1:="No"
.Offset(1).SpecialCells(2).EntireRow.Interior.ColorIndex = xlNone
.Columns(col).AutoFilter
End With
End Sub



Thanks a lot for the response!
Sadly it doesnt work for me.
The actual name in the header is Role Is Overdue, so i changed it in the code to Role Is Overdue and ive tried it as Role_Is_Overdue, but neither work.
What happends is that all rows (except the header) turn red.

Would you happen to know how to resolve this?

Thanks in advance!

Gr,
Bart

[Paul_Hossler]

Option Explicit

Sub MarkOverdue()

Dim r As Range, c As Range
Dim addrFirstFound As String
Dim i As Long

With ActiveSheet.UsedRange
Set c = .Find("Overdue", LookIn:=xlValues)

If Not c Is Nothing Then
addrFirstFound = c.Address

Do
Set r = Intersect(c.EntireColumn, c.CurrentRegion)

For i = 2 To r.Rows.Count
If r.Cells(i, 1).Value = "Yes" Then
Intersect(r.Cells(i, 1).EntireRow, c.CurrentRegion).Interior.Color = vbRed
End If
Next I
Set c = .FindNext(c)

If c Is Nothing Then GoTo DoneFinding

Loop While c.Address <> addrFirstFound
End If

DoneFinding:
End With

End Sub

[BartD]

Option Explicit

Sub MarkOverdue()

Dim r As Range, c As Range
Dim addrFirstFound As String
Dim i As Long

With ActiveSheet.UsedRange
Set c = .Find("Overdue", LookIn:=xlValues)

If Not c Is Nothing Then
addrFirstFound = c.Address

Do
Set r = Intersect(c.EntireColumn, c.CurrentRegion)

For i = 2 To r.Rows.Count
If r.Cells(i, 1).Value = "Yes" Then
Intersect(r.Cells(i, 1).EntireRow, c.CurrentRegion).Interior.Color = vbRed
End If
Next I
Set c = .FindNext(c)

If c Is Nothing Then GoTo DoneFinding

Loop While c.Address <> addrFirstFound
End If

DoneFinding:
End With

End Sub



Thank you so much for your help, it works! Real MVP!

I dont know how to mark the threat as solved, how is that done?

Gr,
Bart

[mdmackillop]

I dont know how to mark the threat as solved, how is that done?
Thread tools at the top of the post.