Shading a cell two different colors?

[aka_krakur]

Is it possible to shade one cell two different colors?
I can't seem to find a way to do it...probably impossible.
Please let me know if it is possible.

Here's what I'm looking for:

 

[Domski]

Normally no as far as I understand.

You may be able to do it with some complicated VBA code but I doubt the result would be worth the effort.

 

[aka_krakur]

That's what I thought. Luckily this one wasn't for me. Co-worker asked me.
Thanks

 

[erik.van.geit]

whywouldyoudothat ?

Option Explicit

Sub whywouldyoudothat()
'Erik Van Geit
'061013

Dim L As Single
Dim T As Single
Dim W As Single
Dim H As Single

    With ActiveCell
    L = .Left
    T = .Top
    H = .Height
    W = .Width
    End With
    
    With ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, L, T, W, H)
    .Flip msoFlipHorizontal
    .Fill.ForeColor.SchemeColor = 41
    '.Fill.Transparency = 0.5
    End With
    
    With ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, L, T, W, H)
    .Flip msoFlipVertical
    .Fill.ForeColor.SchemeColor = 2
    '.Fill.Transparency = 0.5
    End With

End Sub

 

[aka_krakur]

Grouping them now

Is there a way to add in to group these 2 shapes together?
I tried just recording a macro; however, it assigns a new shap# every time it adds them.

Or if not grouping them could there be a written code that says to do this to all cells in column (let's say B) that has data.

A co-worker of mine wants has a cell that has 2 dates (why, I don't know).
separated by a border line that diagonals the cell.
she wants one colored one way and the other colored another way.
So your vba worked perfect. Just wanted to know if there was an easier way than running the script for every cell.

 

[erik.van.geit]

don't ask me to come to your office to delete the shapes !!

Option Explicit

Sub whywouldyoudothat()
'Erik Van Geit
'061013

Dim cell As Range
Dim L As Single
Dim T As Single
Dim W As Single
Dim H As Single

Application.ScreenUpdating = False

    For Each cell In Range("C1:D50")
        If cell <> "" Then
            With cell
            L = .Left
            T = .Top
            H = .Height
            W = .Width
            End With
            
            With ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, L, T, W, H)
            .Flip msoFlipHorizontal
            .Fill.ForeColor.SchemeColor = 41
            .Fill.Transparency = 0.5
            End With
            
            With ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, L, T, W, H)
            .Flip msoFlipVertical
            .Fill.ForeColor.SchemeColor = 2
            .Fill.Transparency = 0.5
            End With
        End If
    Next cell

Application.ScreenUpdating = True

End Sub

quotes deleted to get some transparancy: else you won't see the data
I wouldn't never use this, but like to create this code :wink:

Some post of mine today has code to delete shapes in a range (or at least a link)

kind regards,
Erik

 

[aka_krakur]

Thank you. I know that was unbelievably the most idiotic request you've probably heard on here...and it definitely is not one that I would normally post. But this coworker of mine will definitely be amazed.

Thanks

 

[erik.van.geit]

the most idiotic request you've probably heard on here

no it wasn't
you know, sometimes (for me most of the time) it's just fun

run this code I posted yesterday - really makes no sense

kind regards,
Erik

 

[aka_krakur]

Curious....what was this for..just for fun?

 

[erik.van.geit]

how do children learn ?
often they give themselves a problem and try to solve it
anyway they are learning while playing

often I imagine a problem (Excel or other) and then try to execute
here on the Board people are inventing problems for me

my entire life is playing, also with numbers
(Excel & piano)

getting too personal, time to go to sleep :wink:

10101 looks good to stop today

post 10000 was made at date 10-10 at 10:10 AM and had 10 words: added comments + emoticon without spaces summed to 100 characters: just getting mad about numbers