Thread: Macro VBA for Automatic Row Coloring

Hi all..

Attached is my sample file

And I have this script

Sub auto_open()
DerCell = Selection.Range("A2").End(xlDown).Address
Set MyPlage = Selection.Range("A2:" & DerCell)
Dim MyDate As Date
    MyDate = Now + 7
    
    For Each Cell In MyPlage
        If Cell.Value = [D10] Then
            Cell.EntireRow.Font.ColorIndex = [D10].Font.ColorIndex
            Cell.EntireRow.Interior.ColorIndex = [D10].Interior.ColorIndex
        End If
        If Cell.Value = [D11] Then
            Cell.EntireRow.Font.ColorIndex = [D11].Font.ColorIndex
            Cell.EntireRow.Interior.ColorIndex = [D11].Interior.ColorIndex
        End If
        If Cell.Value = [D12] Then
            Cell.EntireRow.Font.ColorIndex = [D12].Font.ColorIndex
            Cell.EntireRow.Interior.ColorIndex = [D12].Interior.ColorIndex
        End If
        
    Next
End Sub

My objective here is to color the table A2:C7 based on the value of the code that falls under the column A.

That value is actually a code retrieve from the list of values D10:D25

So, depending on the value of the code in column A, I want the respective row to be colored exactly as the code itself (D10:D25).

My current script now color the entire row which I do not want it to be that way. I only want the row to colored up to column C only.

Your help is so much appreciated.

Thank you very much.

To answer your second question first - you cannot undo a marco

Try this version:

Sub auto_open()
DerCell = Selection.Range("A2").End(xlDown).Address
Set MyPlage = Selection.Range("A2:" & DerCell)
Dim MyDate As Date
    MyDate = Now + 7
    
    For Each Cell In MyPlage
Set colRange = Range(Cells(Cell.Row, 1), Cells(Cell.Row, 3))

        If Cell.Value = [D10] Then
            colRange.Font.ColorIndex = [D10].Font.ColorIndex
            colRange.Interior.ColorIndex = [D10].Interior.ColorIndex
        End If
        If Cell.Value = [D11] Then
            colRange.Font.ColorIndex = [D11].Font.ColorIndex
            colRange.Interior.ColorIndex = [D11].Interior.ColorIndex
        End If
        If Cell.Value = [D12] Then
            colRange.Font.ColorIndex = [D12].Font.ColorIndex
            colRange.Interior.ColorIndex = [D12].Interior.ColorIndex
        End If
 Set colRange = Nothing       
    Next
End Sub