VBA to copy colour and text of cell (and not conditional formatting)

[Wojciech]

I'm working on a calendar (see extract) to manage multiple people and tasks, while also pointing out shared events (weekends, holidays, meetings) via conditional formatting.

I have it all pretty much done out, except that I am now trying to color code the tasks (which users input themselves). On a basic level, I need a VBA that will copy the colour and text of a specific cell (in the example given, AJ3), and paste the colour and text across the cells user selected before they hit the button. I say this specifically because I recorded a macro with paste special, and found that it ALMOST did what I needed, but it wrote over all the conditional formatting, which I can't do with. The formatting needs to stay.

I could just record a macro of colouring something red for example, but I'd like the users to be able to change the colours on the right hand side, as tasks will vary and more will be added. Also, I'm a complete newbie to VBA, and I can't figure out how to have the text (T1) paste across all selected fields and not just the first one.

Please help?

 

[Luke M]

Give this a shot. Uses a single macro, and is pretty versatile.

 

[Wojciech]

That is perfect! Thank you so much Luke.
Just for future reference, how did you select the cell to copy from?
I take it that it's:
Set sh = ActiveSheet.Shapes(Application.Caller)

Set rngSource = sh.TopLeftCell.Offset(0, 1)
Of so, if I wanted to move these, say have the formatting cell two spaces apart, or on the left, do I fix the numbers?

 

[Luke M]

Application.Caller will return the name of the shape that called the macro. So, the first line:

Set sh = ActiveSheet.Shapes(Application.Caller)

This lets us identify that shape. This is also why it's important all your shapes have unique names. The next part is where we find the cell

Set rngSource = sh.TopLeftCell.Offset(0, 1)

The TopLeftCell is the cell that the top left portion of the shape resides in. With the starting example, the cell we wanted was 1 cell to the right, so we offset 0 rows, and 1 column. If we wanted to go down one cell, it would be:
Offset(1, 0)

Or to go 2 columns to the left, would be (use negatives to go up/left):
Offset(0, -2)

Does that answer your question?

 

[Wojciech]

Yes.

Thank you Luke, you're a hero.