PDA

View Full Version : [SOLVED] Coloring rows through value in column



BartD
08-31-2017, 05:34 AM
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
08-31-2017, 07:08 AM
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
08-31-2017, 07:34 AM
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
09-01-2017, 05:32 AM
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
09-01-2017, 06:33 AM
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
09-04-2017, 12:20 AM
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
09-04-2017, 01:34 AM
I dont know how to mark the threat as solved, how is that done?
Thread tools at the top of the post.