change color of a range of cels in a row based on the value in one

  • Thread starter Thread starter Srajes
  • Start date Start date
S

Srajes

Hi, I want to automatically change the color of a range of cells when a user
select a specific word from a drop-down list in a cell in that range of cells.

For example: user selects 'FIVE' would change the color of the cells
1,2,3,4,5(FIVE).

1 2 3 4 FIVE


Appreicate any help to implement this.
Thanks
 
Hi,

I'm not following, what is in the five cells? how does 1,2,3,4,5 relate to
the example you are showing us 1,2,3,4? Do you want to format all the cells
one color when the user pick the word Five or do you want to format the cell
containing the number 5 or the cell with the word Five? Do you want to apply
the same color or do you want a different color for each word you pick? What
are the other words on the list and how will they relate to the numbers
1,2,3,4?
 
I have much the same questions as Gord Dibben and Shane Devenshire asked, but
I'm going to give you a possible code solution anyhow.

This code assumes that your lists are all in the same column as defined by
'dropDownsAddresses' and that they are at the right end of the list of
columns that you want shaded. The list of Case Is = tests should include all
possible choices in the dropdowns. If you want different colors, you can
record macros while setting cell shading and examine the code to determine
the .ColorIndex value needed, or check out this page:
http://www.mvps.org/dmcritchie/excel/colors.htm

To put the code in the correct location, choose the sheet that will have the
lists on it and right-click on its name tab and choose [View Code] from the
popup list that appears. Copy the code and paste it into the module that
appears and then edit it as required.

Private Sub Worksheet_Change(ByVal Target As Range)
Const dropDownsAddresses = "D2:D10" ' change as needed
Dim rangeToShade As Range

If Application.Intersect(Target, Range(dropDownsAddresses)) _
Is Nothing Then
Exit Sub ' not a cell in our drop downs addresses area
End If
If Target.Cells.Count > 1 Then
Exit Sub ' changed more than 1 cell as mass [Del]
End If
Set rangeToShade = Range("A" & Target.Row & ":" & _
Target.Address)
'this tests against the possible words without
'regard to UPPER/lower case use, but the words
'must be spelled in ALL UPPERCASE here.
Select Case UCase(Trim(Target))
Case Is = "ONE"
rangeToShade.Interior.ColorIndex = 3 ' red
Case Is = "TWO"
rangeToShade.Interior.ColorIndex = 6 ' yellow
Case Is = "THREE"
rangeToShade.Interior.ColorIndex = 4 ' green
Case Is = "FOUR"
rangeToShade.Interior.ColorIndex = 5 ' blue
Case Is = "FIVE"
rangeToShade.Interior.ColorIndex = 46 ' orange
Case Is = "SIX"
rangeToShade.Interior.ColorIndex = 13 ' violet

Case Else
'not a word in our list
rangeToShade.Interior.ColorIndex = xlNone
End Select

End Sub
 
Back
Top