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

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
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

H
  • Question Question
VBA Pivot Table Dynamic Range & Only One Selection per Row
Replies
3
Views
153
DanteAmor
DanteAmor
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
268
tixarah
T
T
  • Question Question
Open CSV with VBA, convert to ANSI and a cell "75 %" is changed to format type percent and the value is changed to "0.75"
Replies
1
Views
305
Tanquen
T
V
  • Solved
Copy only Value not Formula to new Cell location after ActiveX Macro button pushed.
Replies
2
Views
148
VinnyDoesntKnowExcelCode
V
C
  • Question Question
How to automatically paste the data from one sheet to another using VBA
Replies
4
Views
187
Alex Blakenburg
A

Forum statistics

Threads
1,223,237
Messages
6,170,924
Members
452,366
Latest member
TePunaBloke

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