Can I change cell shading with a drop down without changing the cell value?

[CatherineH]

I have a report that uses colorfunction to differentiate between potential, awarded and lost quotes. Not everyone realises that they must use the exact shades in the legend key, so data is getting left out of the totals. I want to create a dropdown of three particular cell background colours that they can choose without it changing the value already typed in the cell. Does anyone know if this is possible?

Alternatively is there a macro solution that would allow cycling between 4 colour options (the 3 colours and no fill) when you click on the cells in that portion of the worksheet?

 

[MickG]

Try this for cycling through colours in "A1".
Change code Colours and location to suit.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static c As Integer, ColArray As Variant
ColArray = Array(xlNone, 4, 6, 3)
    If Target.Address(0, 0) = "A1" Then
        c = IIf(c = 4, 0, c)
        c = c + 1
        Target.Interior.ColorIndex = ColArray(c - 1)
    End If
End Sub

 

[CatherineH]

Hi,

Thank you.

I added this to module 1 in the workbook

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static c As Integer, ColArray As Variant
ColArray = Array(xlNone, 4, 6, 3)
If Target.Address(0, 0) = "E7:P26,E32:P51" Then
c = IIf(c = 4, 0, c)
c = c + 1
Target.Interior.ColorIndex = ColArray(c - 1)
End If
End Sub

but nothing happens when I click on the cells in the range, I changed "A1" to two of the cell ranges I want to use the feature on, I changed it back to A1 in case I used the wrong syntax for multiple ranges, but nothing happens to A1 either.

 

[CatherineH]

Hi Mick,

I moved the code from module 1 to the sheet I want to apply the function to, and the A1 version works yay, but when I change it to the two ranges (there are actually 50 odd) it doesn't work, so something is wrong with the way I'm referencing the cell ranges... could you assist with the correct syntax for multiple ranges?

 

[MickG]

Try this:-

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static c As Integer, ColArray As Variant
ColArray = Array(4, 6, 3, xlNone)
    If Not Intersect(Target, Range("E7:P26,E32:P51")) Is Nothing Then
        c = IIf(c = 4, 0, c)
        c = c + 1
        Target.Interior.ColorIndex = ColArray(c - 1)
    End If
End Sub

 

[CatherineH]

Thank you Mick,

This code resolved the range issue. Unfortunately now if I select the range of cells (to copy and paste) all cells change to one of the colours even if they were different, or if I try to arrow around the spreadsheet the colours change with each arrow. Is there a way to bind this function to click/right click/dbl click instead of selection change?

 

[MickG]

Try this for "Right Click Event".

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Static c As Integer, ColArray As Variant
ColArray = Array(4, 6, 3, xlNone)
  If Target.Count = 1 Then
    Cancel = True
    If Not Intersect(Target, Range("E7:P26,E32:P51")) Is Nothing Then
        c = IIf(c = 4, 0, c)
        c = c + 1
        Target.Interior.ColorIndex = ColArray(c - 1)
    End If
  End If
End Sub

I can see the drawbacks with this code.
Possibly , you could have a validation list , (somewhere convenient) with the "colourindex" numbers you want, then after your selection any cell within your range that is selected, would be coloured accordingly. When no colour is required you can select the value "XlNone".

 

[CatherineH]

Oh wow, this is perfect! Exactly what I needed, thank you again for your help and your patience.

 

[MickG]

You're welcome