Autoformat row based on values in each cell using Excel VBA? - vba

Question

I have Table1
Column A has a Date e.g. 30/5/2017
Column B has Status e.g "Success"
Column C has Value e.g 500
Requirement: Apply custom Conditional formatting in VBA when a cell is changed
Let's say the change happened in Columns A, B or C in row 5
Regardless whether the change happened in Columns A, B, or C, the same logic should be executed.
If column A value is less than Now(), then row 5 should be red background and white text. No further checks should run.
Else If column B is "Success", then row 5 should be green background and white text. No further checks should run.
Else If column C has value less than 500, then row 5 should be blue background and white text. No further checks should run.
The VBA code below is to check for change on a cell - it autoformats cell in column b with a hyperlink.
What I need now is to autoformat the whole row based on the criteria above.
Private Sub Worksheet_Change(ByVal Target As Range)
If ((Not Intersect(Target, Range("B:B")) Is Nothing) Or (Not Intersect(Target, Range("F:F")) Is Nothing) Or (Not Intersect(Target, Range("G:G")) Is Nothing) Or (Not Intersect(Target, Range("I:I")) Is Nothing)) Then
End If
End Sub

Answer 1

Try this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, R As Range
Dim fCol As Long, bCol As Long
Set Rng = Application.Intersect(Target, Columns("A:C"))
If Not Rng Is Nothing Then
Set Rng = Application.Intersect(Rng.EntireRow, Columns("A:C"))
fCol = vbWhite
For Each R In Rng.Rows
If R.Cells(1, 1).Value <> vbNullString And R.Cells(1, 1).Value < Now Then
bCol = vbRed
ElseIf R.Cells(1, 2).Value <> vbNullString And R.Cells(1, 2).Value = "Success" Then
bCol = vbGreen
ElseIf R.Cells(1, 3).Value <> vbNullString And R.Cells(1, 3).Value < 500 Then
bCol = vbBlue
Else
bCol = xlNone
fCol = vbBlack
End If
R.EntireRow.Interior.Color = bCol
R.EntireRow.Font.Color = fCol
Next
End If
End Sub
Edit:
I have Table1
If Table1 is a ListObject (Excel tables) then we can modify the above code to make it watch first three columns of this table regardless of where the first column is starting (in column "A" or "B" or etc..), and format only the table row not the EntireRow :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LObj As ListObject
Dim RngToWatch As Range
Dim Rng As Range, R As Range
Dim fCol As Long, bCol As Long
Set LObj = ListObjects("Table1") ' the name of the table
Set RngToWatch = Range(LObj.ListColumns(1).DataBodyRange, LObj.ListColumns(3).DataBodyRange)
Set Rng = Application.Intersect(Target, RngToWatch)
If Not Rng Is Nothing Then
Set Rng = Application.Intersect(Target.EntireRow, RngToWatch)
fCol = vbWhite
For Each R In Rng.Rows
If R.Cells(1, 1).Value <> vbNullString And R.Cells(1, 1).Value < Now Then
bCol = vbRed
ElseIf R.Cells(1, 2).Value <> vbNullString And R.Cells(1, 2).Value = "Success" Then
bCol = vbGreen
ElseIf R.Cells(1, 3).Value <> vbNullString And R.Cells(1, 3).Value < 500 Then
bCol = vbBlue
Else
bCol = xlNone
fCol = vbBlack
End If
With Application.Intersect(LObj.DataBodyRange, R.EntireRow)
.Interior.Color = bCol
.Font.Color = fCol
End With
Next
End If
End Sub

Answer 2

I am assuming your table (having three columns) are present in Sheet1.
So, add following code in Sheet1 (not in separate module)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim irow As Variant
' First identify the row changed
irow = Target.Row
' Invoke row formatter routine
Call DefineFormat(irow)
End Sub
Then add following piece of code in a module (you may add under Sheet1 as well but it will limit the uses of this module)
Sub DefineFormat(irow) ' Receive the row number for processing
Dim vVal As Variant
Dim Rng As Range
Dim lFont, lFill As Long
' Define the basis for validation
Dim Current, Success, limit As Variant ' Can be defined as constant as well
Current = Date ' Set today's date
Success = "Success" ' Set success status check
limit = 500 ' Set limit for value check
' Set range for the entire row - Columns A(index 1) to Column C (index 3)
Set Rng = Range(Application.ActiveSheet.Cells(irow, 1).Address, Application.ActiveSheet.Cells(irow, 3).Address)
lFont = vbWhite
' Assuming columns A, B and C needs to be formatted
If Application.ActiveSheet.Cells(irow, 1) < Current Then
lFill = vbRed ' Check for col A
Else:
If Application.ActiveSheet.Cells(irow, 2) = Success Then
lFill = vbGreen ' Check for col B
Else
If Application.ActiveSheet.Cells(irow, 3) < limit Then
lFill = vbBlue ' Check for col C
Else ' Default formatting
lFill = xlNone
lFont = vbBlack
End If
End If
End If
Rng.Interior.Color = lFill
Rng.Font.Color = lFont
End Sub
This will format the row as the data is modified (just like conditional formatting)
Also, if you need to format the entire table in one go, then you may call DefineFormat routine in a loop for each row of the table as illustrated by Fadi in his reply.