UDF to set cell fill from RGB values

[JenniferMurphy]

I need to change the fill color for a column of cells based on RBG values. For example:
[TABLE="class: grid, width: 300"]
<tbody>[TR]
[TD="align: center"]R/C[/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]R
[/TD]
[TD="align: center"]G
[/TD]
[TD="align: center"]B
[/TD]
[TD="align: center"]Color
[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]255[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]255[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]255[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"]85[/TD]
[TD="align: center"]170[/TD]
[TD="align: center"]255[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

In D2:D5, I'd like to set the fill color based on the RGB values in the cells in A:C of that row.

I couldn't find a worksheet function, so I wrote a UDF based on code from the macro recorder.

Here's the recorder code:

Sub Macro1()
    Range("D2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = 5614335
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

If I run it from the macro list, it works, but only on D2 and only for that one color. So I tried to adapt it. I got this, which gets a #VALUE error on the .Pattern statement.

Function SetRGB(inTarget As Range, R As Byte, G As Byte, B As Byte)
inTarget.Select
With Selection.Interior
  .Pattern = xlSolid
  .PatternColorIndex = xlAutomatic
  .color = RGB(R, G, B)
  .TintAndShade = 0
  .PatternTintAndShade = 0
End With

End Function

Is there a way to make this function work?


PS: how come VBA changes the first character of all of the attributes except for .color to upper case?

 

[JenniferMurphy]

Here's the data in the worksheet.

[TABLE="class: grid, width: 397"]
<tbody>[TR]
[TD="align: center"]R/C[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]R[/TD]
[TD="align: center"]G[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]Color[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]255[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"]170[/TD]
[TD="align: center"]85[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"]85[/TD]
[TD="align: center"]170[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]255[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]

I want to select C4:F7 and then call my RGBFill macro, which will assign fill colors to F4:F7 using the RGB values in the column to the left.

I've gotten this far.

Sub RGBFill()
Dim Row1 As Long
Row1 = ActiveCell.Row
Dim ColR As Long
Dim ColG As Long
Dim ColB As Long
ColR = ActiveCell.Column
ColG = ColR + 1
ColB = ColG + 1
  . . .

I am able to obtain the starting row number (Row1 = 7), the R, G, & B columns (ColR = 6, ColG = 7, and ColB = 8).

All I need is either the number of the last row or the number of rows. I can't figure out how to get that.

I'd appreciate some help...

 

[Fluff]

Selection.Rows.Count

This will give you the number of rows selected

 

[JenniferMurphy]

Selection.Rows.Count

This will give you the number of rows selected

Dang it. I thought I tried that. (sigh) That works. Thanks very much.

Here's the working code.

Sub RGBFill()

' --> Add code to check that the range is N x 4
Dim Row1 As Long
Row1 = ActiveCell.Row
Dim ColR As Long: Dim ColG As Long: Dim ColB As Long: Dim ColFill As Long
ColR = ActiveCell.Column: ColG = ColR + 1: ColB = ColR + 2: ColFill = ColR + 3
Dim NumRows As Long
NumRows = Selection.Rows.Count

Dim RowNum As Long
' --> Add code to check that the RGB values are in (0,255)
For RowNum = Row1 To Row1 + NumRows - 1
  Cells(RowNum, ColFill).Interior.Color = RGB(Cells(RowNum, ColR), Cells(RowNum, ColG), Cells(RowNum, ColB))
Next RowNum

End Sub

I still have some error checking to add, but it works.

Thanks to everyone who chipped in.

PS: I learned the hard way that hot-keying back to the worksheet and fiddling around while stepping through the macro in break mode is not a good idea. Since this macro works on the selection, changing it cause all kinds of weird results (and errors).

 

[Greg Truby]

PS: I learned the hard way that hot-keying back to the worksheet and fiddling around while stepping through the macro in break mode is not a good idea. Since this macro works on the selection, changing it cause all kinds of weird results (and errors).

As a general rule, whenever my procedure is going to work on a the Selection object I will have a block of code like so:

    Dim rngSelection As Excel.Range

    If TypeName(Selection) <> "Range" Then
        Exit Sub
    Else
        Set rngSelection = Selection
    End If

I do this :

1. To make sure that the selection isn't a chart or shape or something (even if the workbook doesn't have one at the time it's written, who knows what'll show up years from now).
2. So I can use Intellisense when referencing properties or methods of the selected range as I'm writing the code.
3. As you indicate, if I do need to debug, then I needn't worry about the selection as I step through the code (for this reason I always SET local copies of ActiveCell, ActiveSheet or ActiveWorkbook if I'll be using those somewhere in the procedure; I never assume they'll be the same all the way through a procedure).

 

[JenniferMurphy]

As a general rule, whenever my procedure is going to work on a the Selection object I will have a block of code like so:

    Dim rngSelection As Excel.Range

    If TypeName(Selection) <> "Range" Then
        Exit Sub
    Else
        Set rngSelection = Selection
    End If

I do this :

1. To make sure that the selection isn't a chart or shape or something (even if the workbook doesn't have one at the time it's written, who knows what'll show up years from now).
2. So I can use Intellisense when referencing properties or methods of the selected range as I'm writing the code.
3. As you indicate, if I do need to debug, then I needn't worry about the selection as I step through the code (for this reason I always SET local copies of ActiveCell, ActiveSheet or ActiveWorkbook if I'll be using those somewhere in the procedure; I never assume they'll be the same all the way through a procedure).

Good advice, thanks.