Change color of cells based on value

[Shushanna]

I'm trying to look at column G for accounts that are running out of money or are over spent.

For jRow = 2 To jon.Range("A65536").End(xlUp).Row 'This color codes the %Remaning column
If jon.Cells(jRow, "G").Value < 0.1 Then 'only 10% or less remaining is yellow
ActiveCell.Interior.ColorIndex = 27
End If
If jon.Cells(jRow, "G").Value < 0 Then 'overspent is red
ActiveCell.Interior.ColorIndex = 3
End If
Next jRow

So far it runs without errors, but it only color codes the first cell, and it does it incorrectly. The cell shows "100%" funds remaining, and it has turned the cell yellow. (In the worksheet the decimals are formatted to be percentages.)

I also tried this code and got the same results.

Dim r As Range 'This portion color codes % Remaining values
Dim c As Range
Set r = jon.Range("G2", jon.Range("G65536").End(xlUp))
For Each c In r.Cells
If Application.WorksheetFunction.IsNumber(c.Value) Then
If c.Value < 0.1 Then
ActiveCell.Interior.ColorIndex = 27
End If
If c.Value < 0 Then
ActiveCell.Interior.ColorIndex = 3
End If
End If
Next c

Here is the entire Macro.

Sub total_spent_jon()
'The purpose of this Macro is to sum the amont spent per shop for a JON on DWU_Shop
'and list that sum on DWU_Jon_Balance, and then calculate the Remaining.
Dim shop As Worksheet 'This is the worksheet that lists totals spent per shop
Set shop = Sheets("DWU_Shop")
Dim jon As Worksheet 'This is the worksheet that lists the total budgetted per Jon
Set jon = Sheets("DWU_JON_Balance")
Dim sRow As Long 'row index on shop worksheet
Dim jRow As Long 'row index on jon worksheet
Dim spent As Long 'this is the "shoebox" where we'll be storing and calculating the spent # per Jon
'clearing any values from previous run
Sheets("DWU_JON_Balance").Activate 'This section of code clears the previous Spent values
Range("E2:E300").Select
Selection.ClearContents
Range("G2:G300").Select 'This section of code clears any previous color coding
Selection.Interior.ColorIndex = 0
For jRow = 2 To jon.Range("A65536").End(xlUp).Row 'This loop calculates the total spent per JON
spent = 0
For sRow = 2 To shop.Range("A65536").End(xlUp).Row 'Check Shop worksheet for each JON
If shop.Cells(sRow, "B") = jon.Cells(jRow, "B").Value Then
spent = spent + shop.Cells(sRow, "J").Value 'Add to spent shoebox per JON
End If
jon.Cells(jRow, "E").Value = spent 'paste total spent into jon worksheet
Next sRow
Next jRow
Dim r As Range 'This portion color codes % Remaining values
Dim c As Range
Set r = jon.Range("G2", jon.Range("G65536").End(xlUp))
For Each c In r.Cells
If Application.WorksheetFunction.IsNumber(c.Value) Then
If c.Value < 0.1 Then
ActiveCell.Interior.ColorIndex = 27
End If
If c.Value < 0 Then
ActiveCell.Interior.ColorIndex = 3
End If
End If
Next c
'For jRow = 2 To jon.Range("A65536").End(xlUp).Row 'This color codes the %Remaning column
' If jon.Cells(jRow, "G").Value < 0.1 Then 'only 10% or less remaining is yellow
' ActiveCell.Interior.ColorIndex = 27
' End If
' If jon.Cells(jRow, "G").Value < 0 Then 'overspent is red
' ActiveCell.Interior.ColorIndex = 3
' End If
'Next jRow
End Sub

Any idea what I'm doing wrong?

 

[syntaxed]

The problem might be that although you're looping through all of column G and checking each of the values, the cell that is having its color changed is the ActiveCell. So try changing that by making the changes in red:

First case:

For jRow = 2 To jon.Range("G65536").End(xlUp).Row 'This color codes the %Remaning column
If jon.Cells(jRow, "G").Value < 0.1 Then 'only 10% or less remaining is yellow
jon.cells(jRow,"G").Interior.ColorIndex = 27
End If
If jon.Cells(jRow, "G").Value < 0 Then 'overspent is red
jon.Cells(jRow, "G").Interior.ColorIndex = 3
End If
Next jRow

Second case:

Dim r As Range 'This portion color codes % Remaining values
Dim c As Range
Set r = jon.Range("G2", jon.Range("G65536").End(xlUp))
For Each c In r.Cells
If Application.WorksheetFunction.IsNumber(c.Value) Then
If c.Value < 0.1 Then
c.Interior.ColorIndex = 27
End If
If c.Value < 0 Then
c.Interior.ColorIndex = 3
End If
End If
Next c

 

[Peter_SSs]

Any thought of using Excel's built-in Conditional Formatting to highlight the cells? If you want help with how to do that, post back with what Excel version you are using.

 

[Shushanna]

Thanks, Syntaxed, it worked!

Peter, I'd definitely like to see the Excel solution. Thanks!

 

[Peter_SSs]

Peter, I'd definitely like to see the Excel solution. Thanks!

If you want help with how to do that, post back with what Excel version you are using.