Format Range Based on Column Cell Value in VBA (Not Conditional Formatting)

[Legacy 279814]

Hello Y'all,
I'm familiar with VBA and learning every day. I'm having a bit of trouble creating code that will look at the value in Column K and fill the cells of columns A:J a certain color based on the value in K. Here is a snippet of what I would like to have happen. This report gets e-mailed to me from our Learning Management System and therefore I can not simply use Conditional Formatting as it is a new file every day.

I would like to have items under the Code Column to dictate the color of the cells in column A through J.
The Codes and their colors I am working with are C(Blue), R(Green), X(Red), D(Purple), S(Yellow).

I've been running these reports for a couple years and just started to pick up VBA recently, but this one is throwing me for a bit of a loop. Any help would be appreciated.

Here is a simple example of what I'm working with. The real report is about 3,000 rows of entries to go through. Conditional Formatting has saved a lot of time, but if there is a way to develope a macro so I don't have to keep putting together Conditional Formatting, I would be very happy.[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]G[/TD]
[TD="align: center"]H[/TD]
[TD="align: center"]I[/TD]
[TD="align: center"]J[/TD]
[TD="align: center"]K[/TD]
[TD="align: center"]L[/TD]
[/TR]
[TR]
[TD="align: center"]Last Name[/TD]
[TD="align: center"]First Name[/TD]
[TD="align: center"]Type[/TD]
[TD="align: center"]Item ID[/TD]
[TD="align: center"]Title[/TD]
[TD="align: center"]Assigned[/TD]
[TD="align: center"]Req'd[/TD]
[TD="align: center"]Days[/TD]
[TD="align: center"]Super[/TD]
[TD="align: center"]Comment[/TD]
[TD="align: center"]Code[/TD]
[TD="align: center"]ABS?[/TD]
[/TR]
[TR]
[TD]Smith[/TD]
[TD]Bob[/TD]
[TD]OJT[/TD]
[TD]1234[/TD]
[TD]Training Doc 1[/TD]
[TD]3/23/14[/TD]
[TD]4/1/14[/TD]
[TD]2[/TD]
[TD]Stevens[/TD]
[TD]Complete[/TD]
[TD]C[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]Branson[/TD]
[TD]Steve[/TD]
[TD]TCS[/TD]
[TD]1122[/TD]
[TD]Training Doc 4[/TD]
[TD]3/24/14[/TD]
[TD]4/5/14[/TD]
[TD]6[/TD]
[TD]Stevens[/TD]
[TD]Remind[/TD]
[TD]R[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]Branson[/TD]
[TD]Steve[/TD]
[TD]TCS[/TD]
[TD]1123[/TD]
[TD]Training Doc 5[/TD]
[TD]3/24/14[/TD]
[TD]4/5/14[/TD]
[TD]6[/TD]
[TD]Johnson[/TD]
[TD]Remove[/TD]
[TD]X[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]Pepper[/TD]
[TD]Rodney[/TD]
[TD]OJT[/TD]
[TD]9849[/TD]
[TD]ERT Cert[/TD]
[TD]2/22/14[/TD]
[TD]4/22/14[/TD]
[TD]23[/TD]
[TD]Johnson[/TD]
[TD]Redate[/TD]
[TD]D[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]Shankur[/TD]
[TD]Amiq[/TD]
[TD]TCS[/TD]
[TD]5542[/TD]
[TD]ERT Cert[/TD]
[TD]2/22/14[/TD]
[TD]4/22/14[/TD]
[TD]23[/TD]
[TD]Bradley[/TD]
[TD]Sup.Dir.[/TD]
[TD]S[/TD]
[TD]No[/TD]
[/TR]
</tbody>[/TABLE]

 

[mumps]

Try:

Sub FillRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Range("K2:H" & LastRow)
        If rng = "C" Then
            Range("A" & rng.Row & ":J" & rng.Row).Interior.ColorIndex = 8
        ElseIf rng = "R" Then
            Range("A" & rng.Row & ":J" & rng.Row).Interior.ColorIndex = 4
        ElseIf rng = "X" Then
            Range("A" & rng.Row & ":J" & rng.Row).Interior.ColorIndex = 3
        ElseIf rng = "D" Then
            Range("A" & rng.Row & ":J" & rng.Row).Interior.ColorIndex = 7
        ElseIf rng = "S" Then
            Range("A" & rng.Row & ":J" & rng.Row).Interior.ColorIndex = 6
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

Here is another macro that you can try...

Sub FillRange()
  Const Colors As String = "C08R04X03D07S06"
  Dim X As Long
  For X = 2 To Cells(Rows.Count, "K").End(xlUp).Row
    Cells(X, "A").Resize(, 12).Interior.ColorIndex = Mid(Colors, InStr(Colors, Cells(X, "K").Value) + 1, 2)
  Next
End Sub

 

[Legacy 279814]

Thank you Mumps. This seems to work for me. I think I'll just add this macro to my Quick Access Toolbar and be all set. I appreciate your assistance and prompt reply. Rick, I was unsuccessful with implementing your code. I probably did something on my end but I copied it into my Personal Macro Workbook Module and ran it but nothing happened.

 

[mumps]

Glad I could help.

 

[Rick Rothstein]

Rick, I was unsuccessful with implementing your code. I probably did something on my end but I copied it into my Personal Macro Workbook Module and ran it but nothing happened.

Describe "unsuccessful"... did you get an error message (if so, what one), wrong answers (show examples), or something else?

 

[Legacy 279814]

Describe "unsuccessful"... did you get an error message (if so, what one), wrong answers (show examples), or something else?

When I reloaded the workbook and performed your macro again, it worked. I'm guessing it may have had something to do with the way I dropped it in. Works now. Sorry about the confusion and thanks for the help.

 

[Rick Rothstein]

When I reloaded the workbook and performed your macro again, it worked. I'm guessing it may have had something to do with the way I dropped it in. Works now. Sorry about the confusion and thanks for the help.

No problem... but you did have me going there for a short while as the code I posted is pretty straightforward (no matter that is is compact) and should not have been the cause of any problems.

 

[Legacy 279814]

With both sets of code that you guys uploaded for me, is there a way to have it automatically run the macro every time the color codes are updated. Right now I update the color codes and then have to run the macro from my Quick Access Toolbar or use my shortcut keys...which isn't a huge inconvenience, but if it auto-update in realtime with the data, it would be great.

 

[Rick Rothstein]

With both sets of code that you guys uploaded for me, is there a way to have it automatically run the macro every time the color codes are updated. Right now I update the color codes and then have to run the macro from my Quick Access Toolbar or use my shortcut keys...which isn't a huge inconvenience, but if it auto-update in realtime with the data, it would be great.

You can make the coloring of the cells dynamic by using event code (what ever row you type a code into Column K for, that row will become colored). Here is what I posted earlier modified to work as event code...

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Cell As Range
  Const Colors As String = "C08R04X03D07S06"
  If Target.Count = 1 And Not Intersect(Target, Columns("K")) Is Nothing Then
    Cells(Target.Row, "A").Resize(, 12).Interior.ColorIndex = Mid(Colors, InStr(Colors, Target.Value) + 1, 2)
  End If
End Sub

HOW TO INSTALL Event Code
------------------------------------
If you are new to event code procedures, they are easy to install. To install it, right-click the name tab at the bottom of the worksheet that is to have the functionality to be provided by the event code and select "View Code" from the popup menu that appears. This will open up the code window for that worksheet. Copy/Paste the event code into that code window. That's it... the code will now operate automatically when its particular event procedure is raised by an action you take on the worksheet itself. Note... if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.