Copy color from range of cells

[may]

I'm trying to copy color from cell to cell (not actually range) but it does not work, I always get #VALUE error.
This is my code, it's self-explanatory (the idea is to copy background color, content can be set as blank):



Public Function colorBG(src As Range) As String
ActiveCell.Interior.ColorIndex = src.Interior.ColorIndex
colorBG = ""
End Function


I've even tried using source and destination (dest.Interior.ColorIndex = src.Interior.ColorIndex) but it doesn't work.

Any ideas what am I doing wrong? :-/

[mana]

Option Explicit

Sub test()
Dim r As Range

Set r = Range("a1")

Range("b1").Interior.ColorIndex = colorBG(r)
Range("c1").Interior.ColorIndex = colorBG(r)

End Sub


Private Function colorBG(src As Range) As Integer
colorBG = src.Interior.ColorIndex
End Function

[may]

thanks,

but I don't quite understand it...
As far as I can see, colorBG() retrieves color code and returns it. And test() changes BG of fixed cells (not the ActiveCell) - and it's not even called from within colorBG().

Or am I missing something? :-$






Option Explicit

Sub test()
Dim r As Range

Set r = Range("a1")

Range("b1").Interior.ColorIndex = colorBG(r)
Range("c1").Interior.ColorIndex = colorBG(r)

End Sub


Private Function colorBG(src As Range) As Integer
colorBG = src.Interior.ColorIndex
End Function

[may]

Answering myself, it is actually quite simple when you dismiss the idea of using function in any cell.

I defined a sub that is called every time there is change of selection (=moving around cells) on the current sheet.

As the source and destination columns are known, I used a loop to iterate through all the lines in them.
Instead of "ColorIndex" I used "Color" (that makes the exact copy of color and not the nearest one of 56 Excel colors).

If anyone needs it, here's the code (put under "SheetX" in VBA):



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For line = 1 To 999
Range("I" & line).Interior.Color = Range("A" & line).Interior.Color
Next line
End Sub