It isn't coloring the cell, it is putting a rectangle above the cell and
coloring it. I delete them so they won't build up, but I have removed that
part.

Sub Macro2()
Dim obj As Shape
Dim R as Long, G as Long, B as long
Dim t as Long, l as Long, h as Long, w as Long
End If
R = ActiveCell.Offset(0, -3)
G = ActiveCell.Offset(0, -2)
B = ActiveCell.Offset(0, -1)
t = ActiveCell.Top
l = ActiveCell.Left
w = ActiveCell.Width
h = ActiveCell.Height
Set obj = ActiveSheet.Shapes _
.AddShape(msoShapeRectangle, _
l, t, w, h)
obj.Fill.Solid
obj.Fill.Transparency = 0#
obj.Fill.ForeColor.RGB = RGB(R, G, B)
activecell.offset(1,0).Select
End Sub

Here is a separate macro that deletes them all

Sub DeleteShapes()
Dim obj as Shape
If ActiveSheet.Shapes.Count 0 Then
For Each obj In ActiveSheet.Shapes
obj.Delete
Next
End Sub

--
Regards,
Tom Ogilvy


"Bob Gibbons" wrote in message
. ..
Wow, Tom, I am really impressed with your quick response. The code you
supplied works great with only one exception, which I am hoping is
simple to correct.

The macro works fine for the first cell I color, but when I try to
color the 2nd cell in another location, the macro clears the color out
of the cell I have previously set. I would like to leave the newly set
color and move on to set the color in the new cell.

So everything works must as I need, except that the just set cell is
being reset upon setting the next cell.

Thanks again for your help.

Bob


On Fri, 26 Aug 2005 16:56:54 -0400, "Tom Ogilvy"
wrote:

Sub Macro2()
Dim obj As Shape
Dim R as Long, G as Long, B as long
Dim t as Long, l as Long, h as Long, w as Long
If ActiveSheet.Shapes.Count 0 Then
For Each obj In ActiveSheet.Shapes
obj.Delete
Next
End If
R = ActiveCell.Offset(0, -3)
G = ActiveCell.Offset(0, -2)
B = ActiveCell.Offset(0, -1)
t = ActiveCell.Top
l = ActiveCell.Left
w = ActiveCell.Width
h = ActiveCell.Height
Set obj = ActiveSheet.Shapes _
.AddShape(msoShapeRectangle, _
l, t, w, h)
obj.Fill.Solid
obj.Fill.Transparency = 0#
obj.Fill.ForeColor.RGB = RGB(R, G, B)
End Sub

--
Regards,
Tom Ogilvy

"Bob Gibbons" wrote in message
...
I am trying to usa a VBA macro in Excel to set the interior color of a
cell to a specific RGB value. I want to show a user the apparent color
of a computed RGB value with an accompanying cell or box.

My initial thought was to pick the RGB value from the cells adjacent
to the cell I was trying to color with the following code.

Sub Macro2()
R = ActiveCell.Offset(0, -3)
G = ActiveCell.Offset(0, -2)
B = ActiveCell.Offset(0, -1)
With Selection.Interior
.Color = RGB(R, G, B)
.Pattern = xlSolid
End With
End Sub

This macro works exactly as I hoped, with the exception of the well
know problem that the color set is not the specific RGB value, but
rather the RGB color of the closest match in the color table.

Microsoft Knowledge Base Article 71781 (or 213201), "RGB Function May
Map to Unexpected Color" refers to this problem, and suggests the use
of the ShapeRange object collection instead to get around this
problem.

I tried this with the following code,

Sub Macro2()
R = ActiveCell.Offset(0, -3)
G = ActiveCell.Offset(0, -2)
B = ActiveCell.Offset(0, -1)
With Selection.ShapeRange.Fill.ForeColor.RGB =
RGB(R, G, B)
End With
End Sub

But get an error on the Selection Line.

I am not a VB programmer so am clueless as to what I am doing wrong.

Will the ShapeRange command only work on an inserted Shape rather than
a spreadsheet cell? This is OK, I can insert a rectangular box, but
how do I refer to the cells containing the RGB values?

Any help is much appreciated.

Bob