Reputation: 55

How to make cells with multiple background colors in excel using VBA without gradients?

Ok so here is the problem. How to have multiple background colors in a cell using Microsoft Excel. Microsoft has a built in gradient ability under the format cells menu>Fill>Fill Effects but that uses gradients. I want solid colors.

I will warn you up front that I am about to answer my own question but I can't find this solution any where yet I see a lot of people asking.

Upvotes: 0

Answers (3)

remyfra

Reputation: 54

Old topic but I'm here with another exemple :

    With Selection
        .Interior.Pattern = xlPatternLinearGradient
        .Interior.Gradient.Degree = 90
        .Interior.Gradient.ColorStops.Clear
        .Interior.Gradient.ColorStops.Add(0).Color = 16777215 'no fill
        .Interior.Gradient.ColorStops.Add(0.23).Color = 16777215
        .Interior.Gradient.ColorStops.Add(0.24).Color = 15917529 'blue
        .Interior.Gradient.ColorStops.Add(0.76).Color = 15917529
        .Interior.Gradient.ColorStops.Add(0.77).Color = 16777215
        .Interior.Gradient.ColorStops.Add(1).Color = 16777215
    End With

Upvotes: 0

Gibbs314

Reputation: 55

Here is my solution which I found by altering the code that I recorded for Fill Effects.

In short the key to removing the gradient is to have the colorstops change color very close to eachother.

See my example below. I will post more example in a secondary Answer.

Sub Macro5()
'
' Macro5 Macro
'

'Linear Gradients
'   value       description                         Example
'   0   Degree  Vertical                            1

'Example 1
With Selection.Interior
    .Pattern = xlPatternLinearGradient
    .Gradient.Degree = 0
    .Gradient.ColorStops.Clear
End With

With Selection.Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.49)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.51)
    .ThemeColor = xlThemeColorAccent1
End With

With Selection.Interior.Gradient.ColorStops.Add(1)
    .ThemeColor = xlThemeColorAccent1
End With


End Sub

Upvotes: 2

Gibbs314

Reputation: 55

As promised here are some more example of different cell fill methods.

Sub Macro6()
'
' Macro5 Macro
'

'Linear Gradients
'   value       description                         Example
'   90  Degree  Horizontal                          2
'   45  Degree  Diagonal (UL,LwR Corners)           3
'   135 Degree  Diagonal (LwL UR Corners)           4
'   ??? Degree  Whatever ofther angle you want!     5
'   U = Upper, Lw = Lower, L = Left, R = Right



'Example 2
ActiveCell.Offset(1, 0).Range("A1").Select
With Selection.Interior
    .Pattern = xlPatternLinearGradient
    .Gradient.Degree = 90
    .Gradient.ColorStops.Clear
End With

With Selection.Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.49)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.51)
    .ThemeColor = xlThemeColorAccent1
End With

With Selection.Interior.Gradient.ColorStops.Add(1)
    .ThemeColor = xlThemeColorAccent1
End With

'Example 3
ActiveCell.Offset(1, 0).Range("A1").Select
With Selection.Interior
    .Pattern = xlPatternLinearGradient
    .Gradient.Degree = 45
    .Gradient.ColorStops.Clear
End With

With Selection.Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.49)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.51)
    .ThemeColor = xlThemeColorAccent1
End With

With Selection.Interior.Gradient.ColorStops.Add(1)
    .ThemeColor = xlThemeColorAccent1
End With

'Example 4
ActiveCell.Offset(1, 0).Range("A1").Select
With Selection.Interior
    .Pattern = xlPatternLinearGradient
    .Gradient.Degree = 135
    .Gradient.ColorStops.Clear
End With

With Selection.Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.49)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.51)
    .ThemeColor = xlThemeColorAccent1
End With

With Selection.Interior.Gradient.ColorStops.Add(1)
    .ThemeColor = xlThemeColorAccent1
End With

'Example 5
ActiveCell.Offset(1, 0).Range("A1").Select
With Selection.Interior
    .Pattern = xlPatternLinearGradient
    .Gradient.Degree = 15
    .Gradient.ColorStops.Clear
End With

With Selection.Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.49)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.51)
    .ThemeColor = xlThemeColorAccent1
End With

With Selection.Interior.Gradient.ColorStops.Add(1)
    .ThemeColor = xlThemeColorAccent1
End With

'Rectangular Gradients
'See Example 6
'Selecting Quadrant
'   Property        Value       Example Result
'   RectangleLeft   0 or 1      1       Upper Right Quadrant
'   RectangleTop    0 or 1      0
'   RectangleRight  0 or 1      1
'   RectangleBottom 0 or 1      0

'Selecting Center
'See Example 7
'Value other than .5 get you off center but still off of edge
'   Property        Value       Example Result
'   RectangleLeft   0.5         1       Center
'   RectangleTop    0.5         0
'   RectangleRight  0.5         1
'   RectangleBottom 0.5         0

'Change Size of Quadrant or Center
'see example 8,9
'   Use color stops to do this
'   remember to keep colr stops closs to remove gradient
'   Example color stops at 0, 0.49, 0.51, 1 will give you either
'   a quadrant or approximately half of center

'Example 6

ActiveCell.Offset(1, 0).Range("A1").Select
With Selection.Interior
    .Pattern = xlPatternRectangularGradient
    .Gradient.RectangleLeft = 1
    .Gradient.RectangleTop = 1
    .Gradient.RectangleRight = 1
    .Gradient.RectangleBottom = 1
    .Gradient.ColorStops.Clear
End With

With Selection.Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.49)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.51)
    .ThemeColor = xlThemeColorAccent1
End With

With Selection.Interior.Gradient.ColorStops.Add(1)
    .ThemeColor = xlThemeColorAccent1
End With

'Example 7
ActiveCell.Offset(1, 0).Range("A1").Select
With Selection.Interior
    .Pattern = xlPatternRectangularGradient
    .Gradient.RectangleLeft = 0.5
    .Gradient.RectangleRight = 0.5
    .Gradient.RectangleTop = 0.5
    .Gradient.RectangleBottom = 0.5
    .Gradient.ColorStops.Clear
End With

With Selection.Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.49)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.51)
    .ThemeColor = xlThemeColorAccent1
End With

With Selection.Interior.Gradient.ColorStops.Add(1)
    .ThemeColor = xlThemeColorAccent1
End With

'Example 8
    ActiveCell.Offset(1, 0).Range("A1").Select
With Selection.Interior
    .Pattern = xlPatternRectangularGradient
    .Gradient.RectangleLeft = 1
    .Gradient.RectangleTop = 1
    .Gradient.RectangleRight = 1
    .Gradient.RectangleBottom = 1
    .Gradient.ColorStops.Clear
End With

With Selection.Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.69)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.71)
    .ThemeColor = xlThemeColorAccent1
End With

With Selection.Interior.Gradient.ColorStops.Add(1)
    .ThemeColor = xlThemeColorAccent1
End With

'Example 9
ActiveCell.Offset(1, 0).Range("A1").Select
With Selection.Interior
    .Pattern = xlPatternRectangularGradient
    .Gradient.RectangleLeft = 0.5
    .Gradient.RectangleRight = 0.5
    .Gradient.RectangleTop = 0.5
    .Gradient.RectangleBottom = 0.5
    .Gradient.ColorStops.Clear
End With

With Selection.Interior.Gradient.ColorStops.Add(0)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.29)
    .ThemeColor = xlThemeColorDark1
End With

With Selection.Interior.Gradient.ColorStops.Add(0.31)
    .ThemeColor = xlThemeColorAccent1
End With

With Selection.Interior.Gradient.ColorStops.Add(1)
    .ThemeColor = xlThemeColorAccent1
End With



'Example 10 (German Flag)
ActiveCell.Offset(1, 0).Range("A1").Select
With Selection.Interior
    .Pattern = xlPatternLinearGradient
    .Gradient.Degree = 90
    .Gradient.ColorStops.Clear
End With

With Selection.Interior.Gradient.ColorStops.Add(0)
    .Color = RGB(0, 0, 0)
End With

With Selection.Interior.Gradient.ColorStops.Add(0.329)
    .Color = RGB(0, 0, 0)
End With

With Selection.Interior.Gradient.ColorStops.Add(0.331)
    .Color = RGB(208, 0, 0)
End With

With Selection.Interior.Gradient.ColorStops.Add(0.659)
    .Color = RGB(208, 0, 0)
End With

With Selection.Interior.Gradient.ColorStops.Add(0.661)
    .Color = RGB(255, 206, 0)
End With

With Selection.Interior.Gradient.ColorStops.Add(1)
    .Color = RGB(255, 206, 0)
End With

End Sub

Upvotes: 1

How to make cells with multiple background colors in excel using VBA without gradients?

Answers (3)

Related Questions