Vba code color interior change depending on cell value %

[Alpacino]

I have a value in C1 say 10 got value D1 say 100 (budget) I want to change the color of the cell C1 if the value Is greater than 5% of D1 to Red and if it's under 5% it's yellow. And I like this to repeat from row 1 to 35
Thank you in advance
Alan

 

[cgcamal]

Hi Al,

Go to conditional formatting-->select new rule-->Use a formula...
Now introduce one formula for each color as below image.

Regards

 

[Alpacino]

Thank you for that.

 

[Alpacino]

Anyone who what the vba would be???

 

[fat-tony]

Anyone who what the vba would be???

[COLOR=Navy]Sub [/COLOR]FattyColourChange()
[COLOR=Navy]Dim [/COLOR]dCell As Integer
[COLOR=DarkGreen]'loop from 1 to 35[/COLOR]
[COLOR=Navy]For [/COLOR]i = 1 [COLOR=Navy]To [/COLOR]35
[COLOR=DarkGreen]    'put 5% of the value of cell in column D [/COLOR]
    dCell = CInt(Sheets("Sheet1").Cells(i, 4).Value) / 100 * 5
[COLOR=DarkGreen]    'compare and then change the colour of the cell in column C[/COLOR]
    [COLOR=Navy]If [/COLOR]CInt(Sheets("Sheet1").Cells(i, 3).Value) > dCell [COLOR=Navy]Then[/COLOR]
        Sheets("Sheet1").Cells(i, 3).Interior.ColorIndex = 3
    Else
        Sheets("Sheet1").Cells(i, 3).Interior.ColorIndex = 6
    [COLOR=Navy]End If[/COLOR]
[COLOR=Navy]Next [/COLOR]i
[COLOR=Navy]End Sub[/COLOR]

tested it and it works but doesnt have any error handling for accidental non numbers in there.

 

[chuckles1066]

Just giving something back to this excellent forum, this is my crude solution - others will have better:

 Sub chuckles1066140511()

Dim a, b As Integer

For a = 1 To 35
b = (Cells(a, 3).Value / Cells(a, 4).Value) * 100
Select Case b
    Case Is > 5
        Cells(a, 3).Interior.ColorIndex = 3
    Case Else
        Cells(a, 3).Interior.ColorIndex = 6
End Select
Next a
End Sub

 

[VoG]

Or

Sub test()
Dim i As Long
For i = 1 To 35
    With Range("C" & i)
        .Interior.ColorIndex = IIf(.Value > .Offset(, 1) * 0.05, 3, 6)
    End With
Next i
End Sub

 

[fat-tony]

Anyone who what the vba would be???

Sorry had to make a nice cup of tea for the missus.
Here is a bit nicer. Added a variable called rowStart so that you can change where you want the loop to start from, just in case the first 10 rows or something dont need this code.

Also added the handling to only run the code if both cells contain numbers

[COLOR=Navy]Sub [/COLOR]FattyColourChange2()
[COLOR=Navy]Dim [/COLOR]dCell [COLOR=Navy]As Integer[/COLOR], rowStart [COLOR=Navy]As long[/COLOR]
[COLOR=Navy]Dim [/COLOR]ws [COLOR=Navy]As [/COLOR]Worksheet
[COLOR=DarkGreen]'Define the worksheet name[/COLOR]
[COLOR=Navy]Set [/COLOR]ws = Worksheets("Sheet1")[COLOR=DarkGreen] 'change here and only need to change it once[/COLOR]

 [COLOR=DarkGreen]'you can change this to whatever row you want the loop to start from[/COLOR]
rowStart = 1 [COLOR=DarkGreen]'starts from the first row in the sheet[/COLOR]

[COLOR=DarkGreen]'loop from 1 to 35[/COLOR]
[COLOR=Navy]For [/COLOR]i = 1 [COLOR=Navy]To [/COLOR]35
[COLOR=DarkGreen]    'check that the cells contain numbers[/COLOR]
    [COLOR=Navy]If [COLOR=Black]IsNumeric[/COLOR][/COLOR](ws.Cells(i + rowStart - 1, 4).Value) [COLOR=Navy]And [/COLOR]IsNumeric(ws.Cells(i + rowStart - 1, 3).Value) [COLOR=Navy]Then[/COLOR]
    [COLOR=DarkGreen]'put 5% of the value of cell in column D [/COLOR]
        dCell = ws.Cells(i + rowStart - 1, 4).Value / 100 * 5
    [COLOR=DarkGreen]'compare and then change the colour of the cell in column C[/COLOR]
        [COLOR=Navy]If [/COLOR]ws.Cells(i + rowStart - 1, 3).Value > dCell [COLOR=Navy]Then[/COLOR]
            ws.Cells(i + rowStart - 1, 3).Interior.ColorIndex = 3
        Else
            ws.Cells(i + rowStart - 1, 3).Interior.ColorIndex = 6
        [COLOR=Navy]End If[/COLOR]
    [COLOR=Navy]End If[/COLOR]
[COLOR=Navy]Next [/COLOR]i
[COLOR=Navy]End Sub[/COLOR]

here it is without the rowStart

 [COLOR=Navy]Sub [/COLOR]FattyColourChange2()
 [COLOR=Navy]Dim [/COLOR]dCell [COLOR=Navy]As Integer[/COLOR], 
[COLOR=Navy]Dim [/COLOR]ws [COLOR=Navy]As [/COLOR]Worksheet
[COLOR=DarkGreen]'Define the worksheet name[/COLOR]
[COLOR=Navy]Set [/COLOR]ws = Worksheets("Sheet1")[COLOR=DarkGreen] 'change here and only need to change it once[/COLOR]

 [COLOR=DarkGreen]'you can change this to whatever row you want the loop to start from[/COLOR]
rowStart = 1 [COLOR=DarkGreen]'starts from the first row in the sheet[/COLOR]

 [COLOR=DarkGreen]'loop from 1 to 35[/COLOR]
 [COLOR=Navy]For [/COLOR]i = 1 [COLOR=Navy]To [/COLOR]35
[COLOR=DarkGreen]    'check that the cells contain numbers[/COLOR]
    [COLOR=Navy]If [COLOR=Black]IsNumeric[/COLOR][/COLOR](ws.Cells(i, 4).Value) [COLOR=Navy]And [/COLOR]IsNumeric(ws.Cells(i, 3).Value) [COLOR=Navy]Then[/COLOR]
     [COLOR=DarkGreen]'put 5% of the value of cell in column D [/COLOR]
         dCell = ws.Cells(i, 4).Value / 100 * 5
     [COLOR=DarkGreen]'compare and then change the colour of the cell in column C[/COLOR]
         [COLOR=Navy]If [/COLOR]ws.Cells(i, 3).Value > dCell [COLOR=Navy]Then[/COLOR]
             ws.Cells(i, 3).Interior.ColorIndex = 3
         Else
             ws.Cells(i, 3).Interior.ColorIndex = 6
         [COLOR=Navy]End If[/COLOR]
    [COLOR=Navy]End If[/COLOR]
 [COLOR=Navy]Next [/COLOR]i
 [COLOR=Navy]End Sub[/COLOR]

 

[fat-tony]

Or

Sub test()
Dim i As Long
For i = 1 To 35
    With Range("C" & i)
        .Interior.ColorIndex = IIf(.Value > .Offset(, 1) * 0.05, 3, 6)
    End With
Next i
End Sub

was thinking about using a range instead. this way is much cleaner. nice

 

[chuckles1066]

Or

Sub test()
Dim i As Long
For i = 1 To 35
    With Range("C" & i)
        .Interior.ColorIndex = IIf(.Value > .Offset(, 1) * 0.05, 3, 6)
    End With
Next i
End Sub

<nods in appreciation>

My attempt was that of a novice in all things VBA.

Yours is that of an expert, much neater and compact.

Vive la difference!