Coloring a cell based on another cell value using VBA

[marcelita03]

I usually work on it until I solve it... googling the heck out of it. But it's been days with this one and I can't just figure out what I am doing wrong.
I simply need to change the color cell... if the value of an adjacent cell falls between certain range.

(I CANT USE Conditional Formatting. There is a long reason why. But I don't want to get into that here. I need to do it via Macro)

The cell I need to color has dollars on it. The cell that has the condition is next to it has percent points.

1 Column A Column B
2 $1000 0.001
3 $2000 -3.000
4 $200 0.023
5 $3000 0.000
6 $123 -0.003

If the amount in cell "B2" is less than -1 I want "A2" to be red
If the amount in cell "B2" is between -0.999 and -0.5 I want "A2" to be orange
If the amount in cell "B2" is between -0.499 and 0 I want "A2" to be yellow
If the amount in cell "B2" is between 0.001 and 0.5 I want "A2" to be no color
If the amount in cell "B2" is between 0.499 and 1 I want "A2" to be green
and finally
If the amount in cell "B2" is greater than 1 I want "A2" to be dark green

I need a VBA macro that loops on all values on my list, look for those 6 conditions, and color each cell in A a color depending on what is in column B


This is what I have so far ...

Sub color_cells()  Dim i As Long, r1 As Range, r2 As Range

      Set r1 = Range("A1:A10")
      Set r2 = Range("B1:B10")

    For Each cell In r1
   If IsEmpty(cell) Then GoTo nextcell:
   
   If cell.Value < -1 Then r2.Interior.color = vbRed Else
   If cell.Value >= -0.999 And cell.Value < -0.5 Then r2.Interior.color = vbOrange Else
   If cell.Value >= -0.499And cell.Value < 0 Then r2.Interior.color = vbYellow Else
   If cell.Value >= 0.001 And cell.Value < 0.5 Then r2.Interior.color = vbxlnone Else
   If cell.Value >= 0.499 And cell.Value < 1 Then r2.Interior.color = vblightgreen Else
   If cell.Value >= 0.1 And cell.Value < 0.25 Then r2.Interior.color = vbGreen Else
   If cell.Value > 1Then r2.Interior.color = vbdarkgreen

nextcell:
  Next cell

End Sub

Is not working. The macro runs and colors every cell in my r1 range BLACK! yes BLACK I don't get it.
Any help will be appreciated GREATLY

 

[Fluff]

Firstly try this

Sub color_cells()
Dim i As Long, r1 As Range, r2 As Range

      Set r1 = Range("A1:A10")
      Set r2 = Range("B1:B10")

    For Each cell In r2
   If IsEmpty(cell) Then GoTo nextcell:
   
   If cell.Value < -1 Then cell.Offset(, -1).Interior.Color = vbRed Else
   If cell.Value >= -0.999 And cell.Value < -0.5 Then cell.Offset(, -1).Interior.Color = vbOrange Else
   If cell.Value >= -0.499 And cell.Value < 0 Then cell.Offset(, -1).Interior.Color = vbYellow Else
   If cell.Value >= 0.001 And cell.Value < 0.5 Then cell.Offset(, -1).Interior.Color = vbxlnone Else
   If cell.Value >= 0.499 And cell.Value < 1 Then cell.Offset(, -1).Interior.Color = vblightgreen Else
   If cell.Value >= 0.1 And cell.Value < 0.25 Then cell.Offset(, -1).Interior.Color = vbGreen Else
   If cell.Value > 1 Then cell.Offset(, -1).Interior.Color = vbdarkgreen

nextcell:
  Next cell

End Sub

Secondly I suspect that some of your colours are don't exist, hence you get black

 

[Scott T]

This sets the whole range r2 to red

r2.Interior.color = vbRed Else

for the colors that do not have a vbcolorname you can use RGB values to specify color and

Interior.Color = RGB(255, 153, 0)

for no color it should be

Interior.Color = xlNone

Something like this should work

Sub colorcells()
For x = 1 To 10
    If IsEmpty(Cells(x, 1)) Then GoTo nextcell
        If Cells(x, 1) < -1 Then Cells(x, 2).Interior.Color = vbRed Else
        If Cells(x, 1) >= -0.999 And Cells(x, 1) < -0.5 Then Cells(x, 2).Interior.Color = RGB(255, 153, 0) Else
        If Cells(x, 1) >= -0.499 And Cells(x, 1) < 0 Then Cells(x, 2).Interior.Color = vbYellow Else
        If Cells(x, 1) >= 0.001 And Cells(x, 1) < 0.5 Then Cells(x, 2).Interior.Color = xlNone Else
        If Cells(x, 1) >= 0.499 And Cells(x, 1) < 1 Then Cells(x, 2).Interior.Color = RGB(153, 204, 0) Else
        If Cells(x, 1) >= 0.1 And Cells(x, 1) < 0.25 Then Cells(x, 2).Interior.Color = vbGreen Else
        If Cells(x, 1) > 1 Then Cells(x, 2).Interior.Color = RGB(0, 99, 0)
nextcell:
Next x

End Sub

 

[marcelita03]

Thanks Fluff, I had r2 originally.... I mistakenly changed it when I pasted the code here... but my original code is the same one you have. Still does not work
I changed the colors to the RGB code... still nothing
I think my problem is the ranges... is coloring ALL r2 not EACH cell in r2...
Any thoughts on why and how to solve it?

 

[marcelita03]

Thanks Scott...
Your example will be good if I had only one variable...( For x=1 to 10) but I need to color the cell based on ANOTHER cell....
I still can't figure it out... this is my latest code (with colors fixed)

Sub color_cells()
  Dim i As Long, r1 As Range, r2 As Range

      Set r1 = Range("B1:B25")
      Set r2 = Range("A1:A25")

    For Each cell In r1
    If IsEmpty(cell) Then GoTo nextcell:
   If cell.Value < -0.25 Then r2.Interior.color = RGB(255, 0, 0) Else
   If cell.Value >= -0.25 And cell.Value < -0.1 Then r2.Interior.color = RGB(255, 255, 0) Else
   If cell.Value >= -0.1 And cell.Value < -0.05 Then r2.Interior.color = RGB(255, 255, 204) Else
   If cell.Value >= -0.05 And cell.Value < 0.05 Then r2.Interior.color = xlNone Else
   If cell.Value >= 0.05 And cell.Value < 0.01 Then r2.Interior.color = RGB(0, 255, 0) Else
   If cell.Value >= 0.1 And cell.Value < 0.25 Then r2.Interior.color = RGB(0, 128, 128) Else
   If cell.Value > 0.25 Then r2.Interior.color = RGB(0, 128, 0)

nextcell:
  Next cell
End Sub

Result is... all the range of cells changes colors rapidly and when the macro ends... All cells in Column A are color-less.
You are right... the code is changing the whole list to each color.... (??) hmmm

 

[Scott T]

Had my columns reversed this will check column B and color column A

Sub colorcells()
For x = 1 To 10
    If IsEmpty(Cells(x, 1)) Then GoTo nextcell
        If Cells(x, 2) < -1 Then Cells(x, 1).Interior.Color = vbRed Else
        If Cells(x, 2) >= -0.999 And Cells(x, 2) < -0.5 Then Cells(x, 1).Interior.Color = RGB(255, 153, 0) Else
        If Cells(x, 2) >= -0.499 And Cells(x, 2) < 0 Then Cells(x, 1).Interior.Color = vbYellow Else
        If Cells(x, 2) >= 0.001 And Cells(x, 2) < 0.5 Then Cells(x, 1).Interior.Color = xlNone Else
        If Cells(x, 2) >= 0.499 And Cells(x, 2) < 1 Then Cells(x, 1).Interior.Color = RGB(153, 204, 0) Else
        If Cells(x, 2) >= 0.1 And Cells(x, 2) < 0.25 Then Cells(x, 1).Interior.Color = vbGreen Else
        If Cells(x, 2) > 1 Then Cells(x, 1).Interior.Color = RGB(0, 99, 0)
nextcell:
Next x

End Sub

Since the cell you are testing and the cell you are coloring you only need one for loop. the range object (cells) will just have the same row just different columns.

 

[marcelita03]

Ahhhhh got you!!!
Thank you so much!!! This is exactly what I was looking for.
This is how my final code looks like.
My columns changed from A and B .... now to N and R .... and the rows are really 16 to 25 (not 1 to 10) down now... but I changed that and used your code and works!
Thank you a million times. It works like a charm

Sub colorcells3()
For x = 16 To 25
    If IsEmpty(Cells(x, 14)) Then GoTo nextcell
        If Cells(x, 18) < -1 Then Cells(x, 14).Interior.color = RGB(255, 0, 0) Else
        If Cells(x, 18) >= -0.999 And Cells(x, 18) < -0.5 Then Cells(x, 14).Interior.color = RGB(255, 255, 0) Else
        If Cells(x, 18) >= -0.499 And Cells(x, 18) < 0 Then Cells(x, 14).Interior.color = RGB(255, 255, 204) Else
        If Cells(x, 18) >= 0.001 And Cells(x, 18) < 0.5 Then Cells(x, 14).Interior.color = xlNone Else
        If Cells(x, 18) >= 0.499 And Cells(x, 18) < 1 Then Cells(x, 14).Interior.color = RGB(0, 255, 0) Else
        If Cells(x, 18) >= 0.1 And Cells(x, 18) < 0.25 Then Cells(x, 14).Interior.color = RGB(0, 128, 128) Else
        If Cells(x, 18) > 1 Then Cells(x, 14).Interior.color = RGB(0, 128, 0)
nextcell:
Next x
End Sub