Macro VBA for Automatic Row Coloring

A

aimy

New Member
Joined
Nov 18, 2008
Messages
2
Hi all..

Attached is my sample file..

http://www.speedyshare.com/259873304.html

And I have this script
Code: 
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.
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Sort by date Sort by votes
aimy,

This works for me.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Right click the sheet tab you want the code in (Sheet1), and click on View Code. Paste the code there.

Code: 
Option Explicit
Private Sub Worksheet_Activate()
    Dim MyPlage As Range
    Dim Cell As Range
    Dim DerCell As Long
    DerCell = Range("A" & Rows.Count).End(xlUp).Row
    Set MyPlage = Range("A2:A" & DerCell)
    Dim MyDate As Date
    MyDate = Now + 7
    For Each Cell In MyPlage
        Select Case Cell.Value
            Case "AIR"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D10].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D10].Interior.ColorIndex
            Case "API"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D11].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D11].Interior.ColorIndex
            Case "AST"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D12].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D12].Interior.ColorIndex
            Case "CEL"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D13].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D13].Interior.ColorIndex
            Case "DEB"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D14].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D14].Interior.ColorIndex
            Case "INC"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D15].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D15].Interior.ColorIndex
            Case "LIZ"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D16].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D16].Interior.ColorIndex
            Case "MAA"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D17].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D17].Interior.ColorIndex
            Case "MAK"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D18].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D18].Interior.ColorIndex
            Case "STX"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D19].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D19].Interior.ColorIndex
            Case "TEL"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D20].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D20].Interior.ColorIndex
            Case "MISC"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D21].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D21].Interior.ColorIndex
            Case "MYV"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D22].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D22].Interior.ColorIndex
            Case "SRV"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D23].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D23].Interior.ColorIndex
            Case "SHL"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D24].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D24].Interior.ColorIndex
            Case "TNG"
                Range("A" & Cell.Row & ":C" & Cell.Row).Font.ColorIndex = [D25].Font.ColorIndex
                Range("A" & Cell.Row & ":C" & Cell.Row).Interior.ColorIndex = [D25].Interior.ColorIndex
        End Select
    Next
End Sub


Then, when you select Sheet1, the macro will run.


Have a great day,
Stan
 
Upvote 0
Thank you so much stanleydgromjr!!!
f_tqm_bcc85fd.gif


I really appreciate it..;)

Anyway, actually before you give me the code.. With the help of the original author of the 1st code in my 1st post, I've already manage to get what I want although it is not so efficient as yours.

Just to share with you...

http://www.speedyshare.com/526608816.html

My original case is actually on sheet 2. That is what I want to achieve all thsi while. That is my ATM bank transaction. I want the respective row to be colored automatically depending on the Transaction Code.

Anyway, I have also use the same script on sheet 4 - mrexcel which also contain yours.

This is my script:
Code: 
Sub aquarelle()
 *DerCell = Range("A2").End(xlDown).Address
 *Set MyPlage = Range("A2:" & DerCell)
 *Dim Cell2 As Range
 ** **
 ** * For Each Cell In MyPlage
 ** * * **
 ** * * * If Cell.Value = [d10] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d10].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d10].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d11] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d11].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d11].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d12] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d12].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d12].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d13] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d13].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d13].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d14] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d14].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d14].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d15] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d15].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d15].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d16] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d16].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d16].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d17] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d17].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d17].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d18] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d18].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d18].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d19] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d19].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d19].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d20] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d20].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d20].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d21] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d21].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d21].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d22] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d22].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d22].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d23] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d23].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d23].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d24] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d24].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d24].Font.ColorIndex
 ** * * * End If
 ** * * * If Cell.Value = [d25] Then
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Interior.ColorIndex = [d25].Interior.ColorIndex
 ** * * * * * Range(Cell, Cell.Offset(0, 2)).Font.ColorIndex = [d25].Font.ColorIndex
 ** * * * End If
 *
 ** * * *
 ** * * * 'If Cell.Value <> [H2] And Cell.Value <> [H3] And Cell.Value <> [H4] And Cell.Value <> [H5] _
 ** * 'And Cell.Value <> [H6] And Cell.Value <> [H7] And Cell.Value <> [H8] And Cell.Value <> [H9] _
 ** * 'And Cell.Value <> [H10] And Cell.Value <> [H11] And Cell.Value <> [H12] And Cell.Value <> _
 ** * '[H13] And Cell.Value <> [H14] And Cell.Value <> [H15] And Cell.Value <> [H16] And Cell.Value <> [H17] Then
 ** * * * 'Range(Cell, Cell.Offset(0, -4)).Interior.ColorIndex = xlNone
 ** * * * 'Range(Cell, Cell.Offset(0, -4)).Font.ColorIndex = 1
 ** * * * 'End If
 ** * * **
 ** * Next
 *End Sub
 *
You will see that your script is much more efficient. The aquarelle's will not function fully when there's a blank in the code. Whereas yours works so perfectly!!!
nodding.gif
nodding.gif
*
So, again thank you so much for your help.

If you'd like to help me further, I would like to ask how could I extend your script in such a way that it will automatically change the row color whenever I put/change the code. Can I?*
 
Upvote 0
aimy,

Here you go - Worksheet_Change Event.

Each time you make a change to column A, the three cells will be formatted.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Right click the sheet tab you want the code in, and click on View Code. Paste the code there.

Code: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim MyDate As Date
    MyDate = Now + 7
    Select Case Target.Value
        Case "AIR"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D10].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D10].Interior.ColorIndex
        Case "API"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D11].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D11].Interior.ColorIndex
        Case "AST"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D12].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D12].Interior.ColorIndex
        Case "CEL"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D13].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D13].Interior.ColorIndex
        Case "DEB"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D14].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D14].Interior.ColorIndex
        Case "INC"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D15].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D15].Interior.ColorIndex
        Case "LIZ"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D16].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D16].Interior.ColorIndex
        Case "MAA"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D17].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D17].Interior.ColorIndex
        Case "MAK"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D18].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D18].Interior.ColorIndex
        Case "STX"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D19].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D19].Interior.ColorIndex
        Case "TEL"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D20].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D20].Interior.ColorIndex
        Case "MISC"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D21].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D21].Interior.ColorIndex
        Case "MYV"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D22].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D22].Interior.ColorIndex
        Case "SRV"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D23].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D23].Interior.ColorIndex
        Case "SHL"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D24].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D24].Interior.ColorIndex
        Case "TNG"
            Range("A" & Target.Row & ":C" & Target.Row).Font.ColorIndex = [D25].Font.ColorIndex
            Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = [D25].Interior.ColorIndex
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub


Each time you make a change to column A, the three cells will be formatted.


Have a great day,
Stan
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Counter in For Each loop
Replies
2
Views
273
Possum17
P
gtd526
  • Question
macro to add correct number of ")" at end of nested IF statement
Replies
1
Views
185
gtd526
gtd526
F
  • Question
No cells were found - trying to copy a hidden row range
Replies
3
Views
147
Micron
M
A
  • Question
Worksheet from a template using a master list but protecting existing worksheets
Replies
0
Views
317
Alfalfa166
A
N
  • Question
Count - specific consecutive order
Replies
6
Views
625
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,216,750
Messages
6,132,503
Members
449,730
Latest member
SeanHT

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top