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.
You've got the wrong value for yellow; it should be 65535
. That can be verified in several ways:
? ActiveCell.Interior.Color
? ActiveCell.Interior.Color
in the Immediate Window and pressing Enter .? vbYellow
? vbYellow
in the Immediate Window and pressing Enter .? RGB(255, 255, 0)
? 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.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.