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

CatherineH

New Member
Joined
Aug 6, 2013
Messages
17
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?
 

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this for cycling through colours in "A1".
Change code Colours and location to suit.
Code:
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

New Member
Joined
Aug 6, 2013
Messages
17
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

New Member
Joined
Aug 6, 2013
Messages
17
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

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
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

New Member
Joined
Aug 6, 2013
Messages
17
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

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this for "Right Click Event".

Code:
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

New Member
Joined
Aug 6, 2013
Messages
17
Oh wow, this is perfect! Exactly what I needed, thank you again for your help and your patience.
 

Watch MrExcel Video

Forum statistics

Threads
1,090,507
Messages
5,414,961
Members
403,557
Latest member
hsstrider

This Week's Hot Topics

Top