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?

 

[Rick Rothstein]

A UDF, like any built-in Excel function, cannot make any changes to the worksheet other than to return a value to the cell that it is used in. You could probably use Change event code to do what you want though.

 

[RedBeard]

This might be of help: https://answers.microsoft.com/en-us...b/28c31e39-5fe1-49c1-96dd-c3af0c0d64da?auth=1

 

[JenniferMurphy]

This might be of help: https://answers.microsoft.com/en-us...b/28c31e39-5fe1-49c1-96dd-c3af0c0d64da?auth=1

Wow!!! That looks like exactly what I was hoping for. Thanks a million.

I have run into one little problem. I'd like to assign the macro to a keyboard shortcut, but it isn't listed in the list of macros when I click Macros in the Developer tab. I do have a couple of other macros in Module 1 of VBAProject(PERSONAL.XSLB) and they do show up in the macro list. I put this macro in that same module, but it isn't listed. What am I doing wrong?

 

[RoryA]

To which macro are you referring from that thread? The Tester routine should appear as a macro.

 

[JenniferMurphy]

To which macro are you referring from that thread? The Tester routine should appear as a macro.

I copied one of the macros in the link provided by RedBeard and modified it a bit. Here's the code:

Sub RGBFill(ByVal Target As Range)
Dim r As Range
' --> Add code to check that the range is N x 4
For Each r In Target
  If Application.CountIfs(Cells(r.Row, 1).Resize(1, 3), ">=0", _
                          Cells(r.Row, 1).Resize(1, 3), "<256") = 3 Then
    Cells(r.Row, 4).Interior.Color = RGB(Cells(r.Row, 1), Cells(r.Row, 2), Cells(r.Row, 3))
  End If
Next r
End Sub

I put that code i Module1 of VBAProject(PERSONAL.XSLB) along with a couple of other subs. The other subs all appear in the macro list, but this one (RGBFill) does not.

 

[RoryA]

You can't run that as a macro since it requires a Range argument and you have no way to pass one from the macros dialog. The first code in that link was a worksheet_Change event which runs automatically when you change a range on a worksheet.

 

[JenniferMurphy]

You can't run that as a macro since it requires a Range argument and you have no way to pass one from the macros dialog. The first code in that link was a worksheet_Change event which runs automatically when you change a range on a worksheet.

Rats! Can I remove argument and have the macro query the selection?

 

[RoryA]

Sure:

Sub RGBFill()
Dim r As Range
' --> Add code to check that the range is N x 4
For Each r In Selection.Cells
  If Application.CountIfs(Cells(r.Row, 1).Resize(1, 3), ">=0", _
                          Cells(r.Row, 1).Resize(1, 3), "<256") = 3 Then
    Cells(r.Row, 4).Interior.Color = RGB(Cells(r.Row, 1), Cells(r.Row, 2), Cells(r.Row, 3))
  End If
Next r
End Sub

 

[JenniferMurphy]

Perfect, thanks.

Now I need to change the For loop. Instead of checking each cell on a fixed range, I want to do it one row at a time over the entire selection. Given the current selection, I need to extract:

1. The number of the first row in the selection.
2. The number of rows or the number of the last row in the selection.
3. The number of the first column in the selection.

I can't quite seem to get the syntax right.

Thanks