Copy Cell Backgroundcolor

Question

I'm using Excel 2013 and I want to write a Function in VBA that has two Parameters (Sourcecell and Destinationcell) and simply copies the Backgroundcolor from Sourcecell to the Destinationcell. This is what I have:

Function setRGB2(ByVal sCell As Range, ByVal dCell As Range)
Dim lngColor As Long
Dim B As Long
Dim G As Long
Dim R As Long

On Error GoTo Fehler

lngColor = sCell.Interior.Color
B = lngColor / 65536
G = (lngColor - B * 65536) / 256
R = lngColor - B * 65536 - G * 256

Range(dCell).Interior.Color = RGB(R, G, B)
'Range(dCell).DisplayFormat.Interior.Color = RGB(R, G, B)

Fehler:
    With Err

    End With
End Function

I get the Error:

improper use of a property

For Example my Sourcecell is B16 and my Destinationcell is B46. So in B46 I write =setRGB2($B$16;B46). I tried setting the Color directly like dCell.Interior.Color = sCell.Interior.Color but that didn't work.

EDIT

I have added the Declaration for the Parameters. But it seems to be another Problem. Even if I do dCell.Interior.ColorIndex = 1 it throws the same error.

How are you using this function and why don't you just assign the `Interior.Color` of one cell to the other directly? — Rory, Apr 10 '18 at 08:27
Why don't you just use `Range(dCell).Interior.Color = sCell.Interior.Color`? Why so complicated? Also specify a type for your `sCell, dCell` in `setRGB2(sCell, dCell)` — Pᴇʜ, Apr 10 '18 at 08:30
Please declare sCell and dCell, so we know what we are talking about. Please also make sure that R is greater than 0, please have a look at [RGB](https://msdn.microsoft.com/de-de/VBA/Language-Reference-VBA/articles/rgb-function) — Storax, Apr 10 '18 at 08:33
Remember to check for the default no-colour, when `sCell.Interior.ColorIndex = xlColorIndexNone` — Chronocidal, Apr 10 '18 at 09:17

Foxfire And Burns And Burns · Accepted Answer · 2018-04-10T09:25:23.190

User Defined Functions cannot change the state of worksheet/cells. In other words, cannot change colors. (Source)

But Subs can do, so you can design a Function and then call the function from the Sub.

But in your case, a Sub with parameters should do and you can call it in your VBA code whenever you want, in an easy way.

Sub testing()

setRGB2 [A1], [A2]

End Sub

Private Sub setRGB2(ByRef sCell As Range, ByRef dCell As Range)

dCell.Interior.Color = sCell.Interior.Color
End Sub

Also, I said at start of my answer that an UDF cannot change the state of a worksheet, but if for any reason you really need it, there is a way to do it in a really complex and hardcore way.

UDF to change cells color

Also, in your question you say:

For Example my Sourcecell is B16 and my Destinationcell is B46. So in B46 I write =setRGB2($B$16;B46)

This is wrong because you are creating a circular reference, and that's causing you an error.

More about circular references

Nice find on the UDF to change the colour of a cell! There's also [this](https://stackoverflow.com/questions/23433096/using-a-udf-in-excel-to-update-the-worksheet) link buried in there which might be easier to implement? — Chronocidal, Apr 10 '18 at 09:35
I was guessing something along the lines. Thanks for the links. — BluePalmTree, Apr 10 '18 at 09:37

score 0 · Answer 2 · answered Apr 10 '18 at 09:05

0

Not sure what you want to achieve with the function but the follwoing code should be correct, at least syntactically

Option Explicit

Function setRGB2(ByVal sCell As Range, ByVal dCell As Range)
    Dim lngColor As Long
    Dim B As Long
    Dim G As Long
    Dim R As Long

'    On Error GoTo Fehler

    lngColor = sCell.Interior.Color
    B = WorksheetFunction.Max(lngColor / 65536, 0)
    G = WorksheetFunction.Max((lngColor - B * 65536) / 256, 0)
    R = WorksheetFunction.Max(lngColor - B * 65536 - G * 256, 0)

    dCell.Interior.Color = RGB(R, G, B)
    'Range(dCell).DisplayFormat.Interior.Color = RGB(R, G, B)

    Exit Function

Fehler:
    With Err

    End With
End Function

Sub TestIt()
    setRGB2 Range("A1"), Range("A2")
End Sub

answered Apr 10 '18 at 09:05

Storax

11,158
3
16
33

The RGB split is unneccessary, but it's *far* easier with [Bitwise Operators](https://learn.microsoft.com/en-us/dotnet/visual-basic/programming-guide/language-features/operators-and-expressions/logical-and-bitwise-operators): `B = (lngColor AND rgbBlue)/65536: G=(lngColor AND rgbLime)/256: R=(lngColor AND rgbRed)` – Chronocidal Apr 10 '18 at 09:16
1

I would say, just `dCell.Interior.Color = sCell.Interior.Color`should be sufficient. – Storax Apr 10 '18 at 09:18
Yeah, as I said, the RGB split is unneccessary. – Chronocidal Apr 10 '18 at 09:21

score 0 · Answer 3 · answered Apr 10 '18 at 09:20

Check if the cell has a colour first, and if so then just copy it:

Public Sub CopyColour(ByRef Source As Range, ByRef Destination As Range)
    If Source.Interior.ColorIndex = xlColorIndexNone Then
        Destination.Interior.ColorIndex = xlColorIndexNone
    Else
        Destination.Interior.Color = Source.Interior.Color
    End If
End Sub

Doesn't manage gradients or patterns.

Copy Cell Backgroundcolor

3 Answers3