Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

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
like image 944
Mohamed Heiba Avatar asked Mar 29 '17 21:03

Mohamed Heiba


2 Answers

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 
like image 114
Fadi Avatar answered Nov 03 '22 10:11

Fadi


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.

like image 34
ArindamD Avatar answered Nov 03 '22 09:11

ArindamD