Finding the Interior Color value of a cell using VBA

Hi there guys,

Firstly, I have done many Google searches for this, i'm not sure if my terminology is wrong or if I'm too much of a rookie to figure out what i'm seeing, but I'm unable to use what I find in my own project. I hope someone can help.

In Sheet1 cells A1-BW46 (3450 cells), using 9 different colors to fill all the cells.

In Sheet3, starting in A2, I have a plain text list of 3450 cell ranges "A1", "A2", "A3" etc covering all 3450 cells in Sheet1.

I want to populate next to this list the interior color value of the corresponding cell. So in cell A2, I will have the text "A1", in cell B2 I would have either a numerical or text value giving me the color that A1 in sheet1 is filled with.

• The script doesn't have to auto update, I will run manually when needed
• I don't need any manipulation, only the value of the color, and that can be hex, rgb or any other way
• I'd be happy with a complete script obviously, but pointing me in the right direction would also be much appreciated!

Sorry if this isn't clear. I can't upload the actual sheet I'm working with, but if my description of the problem is lacking, I may be able to create a sample sheet to give the idea.

Many thanks in advance guys

Darth269

This should do B2:

With Sheet3.Range("B2")
    .Value = Sheet1.Range(.Offset(, -1)).Interior.ColorIndex
End With

Or for a range:

Sub x()

Dim r As Range

For Each r In Sheet3.Range("B2:B4")
    r.Value = Sheet1.Range(r.Offset(, -1)).Interior.ColorIndex
Next r

End Sub

Though ragulduy's approach is better.

Be careful of multiple cell ranges passed to the function, though:

Function CellColor(myCell As Range)
CellColor = myCell.Cells(1, 1).Interior.ColorIndex
End Function

Not sure this does what you want so test on a copy first.

Sub Darth269()
Dim rcell As Range
Sheets("Sheet3").Activate
For Each rcell In Range("A1:A" & Range("A" & Rows.count).End(3)(1).Row)
    rcell.Offset(, 1).Value = Sheets("Sheet1").Range(rcell.Value).Interior.Color
Next rcell
End Sub