CODEWITHSUNDEEP
excelvba
wilberox
wilberox

Reputation: 193

How to change value of a cell based on cell fill color

I have a spreadsheet in excel where there are three types of cell. Black cells, yellow cells and cells with no fill. I am trying to write code so that the black cells will contain value 1, the yellow cells value 2 and the no fill cells value 0.

So far, this is what I have for the black and yellow cells:

Sub changeValuesBasedOnColour()

    Dim rg As Range
    Dim xRg As Range
    Set xRg = Selection.Cells
    Application.DisplayAlerts = False
    For Each rg In xRg
        With rg
            Select Case .Interior.Color
                Case Is = 0   'Black
                    .Value = 1
                Case Is = 255255 'Yellow
                    .Value = 2
            End Select
        End With
    Next
    Application.DisplayAlerts = False


End Sub

This has worked for the cells in my spreadsheet which are filled black: they all now contain the value 1. However, nothing has changed for my cells filled yellow.

I thought that it could be to do with the wrong HEX code, but I have tried 2552550 and ```255255000`` as well. The yellow cells are filled with the yellow from the excel standard colors, as seen below.

excel standard colours

Upvotes: 0

Views: 207

Answers (2)

Variatus
Variatus

Reputation: 14373

The colours must be specified exactly. Yellow <> Yellow. There are a thousand shade of yellow. The first instance of Application.DisplayAlerts = False in your code is unnecessary. The second one is a mistake.

The code below takes an approach opposite to the one you started out with. It reads the colour set and applies an index number if it's a "known" colour. The advantage of this system is that it's much easier to maintain and expand.

Sub SetValuesBasedOnColour()

    Dim Cols    As Variant                  ' array of colours
    Dim Idx     As Long                     ' index of Cols
    Dim Cell    As Range                    ' loop object
    
    Cols = Array(vbBlack, vbYellow)
    For Each Cell In Selection.Cells
        With Cell
            On Error Resume Next
            Idx = WorksheetFunction.Match(.Interior.Color, Cols, 0)
            If Err.Number = 0 Then .Value = Idx
        End With
    Next Cell
End Sub

Upvotes: 1

BigBen
BigBen

Reputation: 49998

You've got the wrong value for yellow; it should be 65535. That can be verified in several ways:

  1. Selecting a yellow-colored cell and entering ? ActiveCell.Interior.Color in the Immediate Window and pressing Enter.
  2. Entering ? vbYellow in the Immediate Window and pressing Enter.
  3. Entering ? RGB(255, 255, 0) in the Immediate Window and pressing Enter.

In your code, you can just use vbBlack and vbYellow instead of 0 and 65535 respectively.

Upvotes: 1

Related Questions