VBA Conditional Formatting with Gradient Fill

[Dabaron2321]

Hi I'm trying to combine two sets of VBA but as I have very little expeience of dealing with VBA I don't know how. Basically I want to end up with what I described in the title.

The First thing I'm wanting is to fill the cells background based on its Value, and based on what i've found online I have this example:

If A1 contains "Emily", A2 contains "Joshua", A3 contains "Steve", and B1 to B3 contain values between 200 and 500 I have the following code:

Private Sub Worksheet_Change(ByVal Target As Range)

Set I = Intersect(Target, Range("B2:F11"))
If Not I Is Nothing Then
Select Case Target
Case "Emily": Newcolor = 37
Case "Joshua": Newcolor = 46
Case "Steve": Newcolor = 12
Case 200 To 300: Newcolor = 10
Case 301 To 400: Newcolor = 3
Case 401 To 500: Newcolor = 25
End Select
Target.Interior.ColorIndex = Newcolor
End If

But I also want the fill to be gradient with up to 3 colours and also be able to change the text colour rather than just having the basic one colour formatting of the previous example, more something utilizing the following perhaps?

Set objColorStop = Sheet6.Cells.Interior.Gradient.ColorStops.Add(0)
objColorStop.Color = RGB(0, 64, 255)

Set objColorStop = Sheet6.Cells.Interior.Gradient.ColorStops.Add(0.33)
objColorStop.Color = RGB(200, 64, 0)

Set objColorStop = Sheet6.Cells.Interior.Gradient.ColorStops.Add(0.66)
objColorStop.Color = RGB(128, 250, 0).

But I have no idea what to edit in or out or how to construct a refined code, Any help in putting this together would be really appreciated!​

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

This should get you started:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim clr1 As Long
    Dim clr2 As Long
    Dim clr3 As Long
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B2:F11")) Is Nothing Then
        Select Case Target
            Case "Emily":    clr1 = RGB(255, 0, 0): clr2 = RGB(0, 255, 0): clr3 = RGB(0, 0, 255)
            Case "Joshua":   clr1 = 255: clr2 = 49407: clr3 = 140000
            Case "Steve":    clr1 = 255: clr2 = 49407: clr3 = 140000
            Case 200 To 300: clr1 = 255: clr2 = 49407: clr3 = 140000
            Case 301 To 400: clr1 = 255: clr2 = 49407: clr3 = 140000
            Case 401 To 500: clr1 = 255: clr2 = 49407: clr3 = 140000
            Case Else: Exit Sub
        End Select

        With Target.Interior
            .Pattern = xlPatternLinearGradient
            .Gradient.Degree = 0
            .Gradient.ColorStops.Clear
            With .Gradient.ColorStops.Add(0)
                .Color = clr1
            End With
            With .Gradient.ColorStops.Add(0.3)
                .Color = clr2
            End With
            With .Gradient.ColorStops.Add(1)
                .Color = clr3
            End With
        End With
    End If
End Sub

I created three numbers for the colours: clr1, clr2 and clr3.
You can set these by using RGB() or by assigning the equivalent number directly.
The numbers are worked out first then they are applied.

 

[Dabaron2321]

Yes thats exactly what I needed, Thanks!

 

[RickXL]

You're welcome and thanks for letting me know.

 

[Javier Chaires]

Hola buen dia tengo una duda si me pudieran ayudar, como modificar el código para poner los números de los colores los tome de una celda de la hoja excel para que el usuario los pueda cambiar y se modifiquen automáticamente en base a los valores que el usuario ingrese, espero haberme explicado gracias.