+ Reply to Thread
Results 1 to 3 of 3

Macro VBA for Automatic Row Coloring

Hybrid View

  1. #1
    Registered User
    Join Date
    11-18-2008
    Location
    Malaysia
    Posts
    2

    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.
    Attached Files Attached Files
    Last edited by VBA Noob; 11-19-2008 at 04:21 AM.

  2. #2
    Registered User
    Join Date
    11-18-2008
    Location
    Malaysia
    Posts
    2
    By the way, I also want to ask.. Is there anyway to undo the Macro?

    Thanks.

  3. #3
    Valued Forum Contributor mdbct's Avatar
    Join Date
    11-11-2005
    Location
    CT
    MS-Off Ver
    2003 & 2007
    Posts
    848
    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
    Last edited by mdbct; 11-19-2008 at 12:31 AM. Reason: fixed mutliple typos - had colRamge instead of colRange

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1