Set background color based on cell value

Hi all,
I have a workbook in which I want to set the background color based on a specific value in each individual cell within a specific range (not the entire sheet) and I have five values I want to use (1 to 5).
I tried IF-Then-Else but didn't get the syntax right.

Just to clarify, if I type 1in cell A1, I want the background to be red, if I type 2, I want the background to be green etc..
I tried the following code with no luck.:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

If Selection.Value = 1 Then Selection.Interior.ColorIndex = 27 Else Selection.Interior.ColorIndex = xlNone
If Selection.Value = 2 Then Selection.Interior.ColorIndex = 3 Else Selection.Interior.ColorIndex = xlNone
If Selection.Value = 3 Then Selection.Interior.ColorIndex = 4 Else Selection.Interior.ColorIndex = xlNone
If Selection.Value = 4 Then Selection.Interior.ColorIndex = 32 Else Selection.Interior.ColorIndex = xlNone
If Selection.Value = 5 Then Selection.Interior.ColorIndex = 46 Else Selection.Interior.ColorIndex = xlNone

End Sub

Hi,

Have you tried using Conditional Formatting?

Dom

What about if they just decide not to enable macros? Trying to replicate what can already be done with standard Excel functionality is really just making life hard for yourself if you ask me.

This would be how you would go about it if you decide to though:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngChangeRange As Range
    Dim rngLoopRange As Range

    On Error GoTo ErrorHandler
    Application.EnableEvents = False

    Set rngChangeRange = Intersect(Target, Range("A1:A10"))

    If Not rngChangeRange Is Nothing Then
        For Each rngLoopRange In rngChangeRange
            Select Case rngLoopRange.Value
                Case 1
                    rngLoopRange.Interior.ColorIndex = 27
                Case 2
                    rngLoopRange.Interior.ColorIndex = 3
                Case 3
                    rngLoopRange.Interior.ColorIndex = 4
                Case 4
                    rngLoopRange.Interior.ColorIndex = 32
                Case 5
                    rngLoopRange.Interior.ColorIndex = 46
                Case Else
                    rngLoopRange.Interior.ColorIndex = xlNone
            End Select
        Next rngLoopRange
    End If

CleanExit:
    Application.EnableEvents = True
    Exit Sub

ErrorHandler:
    MsgBox Err & " - " & Err.Description
    GoTo CleanExit

End Sub

The above example checks range A1:A10 so change as required. The code needs to go on the worksheet's code page.

Dom

Hi,

No worries. I guess you could do it like this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngChangeRange As Range
    Dim rngLoopRange As Range

    On Error GoTo ErrorHandler
    Application.EnableEvents = False

    Set rngChangeRange = Intersect(Target, Range("A1:A10"))

    If Not rngChangeRange Is Nothing Then
        For Each rngLoopRange In rngChangeRange
            Select Case rngLoopRange.Value
                Case 1
                    rngLoopRange.Interior.ColorIndex = 27
                    Sheets("Sheet2").Range(rngLoopRange.Address) _
                        .Interior.ColorIndex = 27
                Case 2
                    rngLoopRange.Interior.ColorIndex = 3
                    Sheets("Sheet2").Range(rngLoopRange.Address) _
                        .Interior.ColorIndex = 3
                Case 3
                    rngLoopRange.Interior.ColorIndex = 4
                    Sheets("Sheet2").Range(rngLoopRange.Address) _
                        .Interior.ColorIndex = 4
                Case 4
                    rngLoopRange.Interior.ColorIndex = 32
                    Sheets("Sheet2").Range(rngLoopRange.Address) _
                        .Interior.ColorIndex = 32
                Case 5
                    rngLoopRange.Interior.ColorIndex = 46
                    Sheets("Sheet2").Range(rngLoopRange.Address) _
                        .Interior.ColorIndex = 46
                Case Else
                    rngLoopRange.Interior.ColorIndex = xlNone
                    Sheets("Sheet2").Range(rngLoopRange.Address) _
                        .Interior.ColorIndex = xlNone
            End Select
        Next rngLoopRange
    End If

CleanExit:
    Application.EnableEvents = True
    Exit Sub

ErrorHandler:
    MsgBox Err & " - " & Err.Description
    GoTo CleanExit

End Sub

Dom

or

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
    With Target.Interior
      .ColorIndex =xlnone
      If target.value >0 and target.value<6 then .ColorIndex = choose(target.value,27,3,4,32,46)
      Sheets("Sheet2").Range(target.address).Interior.ColorIndex = .colorindex
    End With
  End If
End Sub

Originally Posted by tgal

Hi, I have but my managers have the ability to **** up just about everything , that's why I want to use VBA.
Thanks,
Thomas

From this I take it he wants to cover just about every eventuality

I just don't see the point on limiting the code to working on one cell (at least without warning the user that they should only change one cell if they do change more) when a range can be handled quite easily.

I used to limit change events to working on one cell but personally think this is a better approach.

Dom

In that case I'd prefer:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
  For Each cl In Intersect(Target, Range("A1:A10"))
    With cl.Interior
      .ColorIndex = xlNone
      If cl > 0 And cl < 6 Then .ColorIndex = Choose(cl, 27, 3, 4, 32, 46)
      Sheets("Sheet2").Range(cl.Address).Interior.ColorIndex = .ColorIndex
    End With
  Next
End Sub

Dom, works like a dream! Thanks a lot for your time and effort, it's highly appreciated.

Another question, if I may. If I want to have the same formatting in another sheet with a linked formula to sheet1, like "=Sheet1!A1" in cell A1 in sheet2, is that possible or would it be easiest just to copy and paste formatting?

(I plan to hide the sheets an unhide them with VBA, showing just a blank sheet saying "If you see thism pls reopen with macros enabled bla bla bla")

Best regards

Thomas