VBA: Change Font Color Based on Value

[unknownymous]

Hi Gurus

I found below code for changing the negative number in red.

= = = = =
Sub One_Way()
Dim c As Range
For Each c In Selection
If c.Value < 0 Then c.Font.Color = vbRed
Next c
End Sub

Source: VBA code to make negative numbers red and positive numbers black

= = = = =

However, what I have below criteria:

Sheets to Check:
Sheet 1 = Columns X to Z (Header is in Row 2)
Sheet 5 = Columns F & R-S (Header is in Row 2)

1. If Number is Less than 0, font color will be RGB(204, 0, 153)
2. If Number is Greater than 0, font color will be RGB(0, 102, 255)
3. If Number is Greater than 0, font color will be RGB(0, 0, 0)

Appreciate the help.

 

[bebo021999]

1. If Number is Less than 0, font color will be RGB(204, 0, 153)
2. If Number is Greater than 0, font color will be RGB(0, 102, 255)
3. If Number is Greater than 0, font color will be RGB(0, 0, 0)

Appreciate the help.

Number 3, which number, again? Do you mean equals 0?

 

[bebo021999]

OK. Try below code. Feel free to call me back if thing go wrong.

Option Explicit
Sub color()
Dim ws As Worksheet, cell As Range, lcell As Range, u As Range
For Each ws In Sheets
    Select Case ws.Name
        Case "Sheet1"
            ws.Activate
            Set lcell = ws.Range("X3:Z1000000").Find(what:="*", SearchDirection:=xlPrevious)
            If Not lcell Is Nothing Then Set u = ws.Range("X3:Z" & lcell.Row) ' for ex: u = X3:Z100 if 100 is last used row
        Case "Sheet5"
            ws.Activate
            Set lcell = ws.Range("F3:S1000000").Find(what:="*", SearchDirection:=xlPrevious)
            If Not lcell Is Nothing Then Set u = ws.Range("F3:F" & lcell.Row & ",R3:S" & lcell.Row) ' for ex: u = F3:F100 & R3:S100, if 100 is last used row
    End Select
    If Not u Is Nothing Then
        For Each cell In u ' loop thru each cell
            If IsNumeric(cell) Then ' if cell is numeric then
                With cell.Font
                    .color = RGB(0, 0, 0) ' set defaul color is black
                    If cell.Value > 0 Then
                        .color = RGB(0, 102, 255) 'if cell > 0 then blue
                    ElseIf cell.Value < 0 Then
                        .color = RGB(204, 0, 153) 'if cell < 0 then pink
                    End If
                End With
            End If
        Next
    End If
Next
End Sub

 

[unknownymous]

OK. Try below code. Feel free to call me back if thing go wrong.

Option Explicit
Sub color()
Dim ws As Worksheet, cell As Range, lcell As Range, u As Range
For Each ws In Sheets
    Select Case ws.Name
        Case "Sheet1"
            ws.Activate
            Set lcell = ws.Range("X3:Z1000000").Find(what:="*", SearchDirection:=xlPrevious)
            If Not lcell Is Nothing Then Set u = ws.Range("X3:Z" & lcell.Row) ' for ex: u = X3:Z100 if 100 is last used row
        Case "Sheet5"
            ws.Activate
            Set lcell = ws.Range("F3:S1000000").Find(what:="*", SearchDirection:=xlPrevious)
            If Not lcell Is Nothing Then Set u = ws.Range("F3:F" & lcell.Row & ",R3:S" & lcell.Row) ' for ex: u = F3:F100 & R3:S100, if 100 is last used row
    End Select
    If Not u Is Nothing Then
        For Each cell In u ' loop thru each cell
            If IsNumeric(cell) Then ' if cell is numeric then
                With cell.Font
                    .color = RGB(0, 0, 0) ' set defaul color is black
                    If cell.Value > 0 Then
                        .color = RGB(0, 102, 255) 'if cell > 0 then blue
                    ElseIf cell.Value < 0 Then
                        .color = RGB(204, 0, 153) 'if cell < 0 then pink
                    End If
                End With
            End If
        Next
    End If
Next
End Sub

It's working! Massive thanks