Colouring multiple cells, in different shades, based on original cell value

Question

I am trying to create a macro that will divide a cell value and if the value is more than 7.5, then colour the cell dark green and then keep on colouring the subsequent cells dark green, for instance 2.25 would be 2 cells dark green and the .25 light green. Moreover, if the colour content of the cell, which is to be coloured, is grey then keep on moving the activecell until it is on a cell with no colour.

For Each y In rng If Not IsEmpty(y) And y > 7.5 And y <> "" And IsNumeric(y) Then 'I am having trouble here y.Select With ActiveCell.Offset(0, i).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With col = y.Value / 7.5 Count = Left(col, Len(col) - InStr(1, col, ".")) For i = 1 To Count Do While ActiveCell.Offset(0, i).TintAndShade = -0.149998474074526 i = i + 1: Count = Count + 1 Loop ActiveCell.Offset(0, i).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With Next i Count = Right(col, Len(col) - InStr(1, col, ".")) If Count > 0 And Count < 25 Then ActiveCell.TintAndShade = -4.99893185216834E-02 ElseIf Count > 26 And Count < 50 Then ActiveCell.TintAndShade = 0.799981688894314 ElseIf Count > 75 And Count < 100 Then ActiveCell.TintAndShade = 0.599993896298105 End If Next y End If Next y

The macro is for showing workload across the week, with the greyed cells being weekend, so they would need to be skipped.

If Not IsEmpty(y) And y > 7.5 And y <> "" And IsNumeric(y) Then at the moment it will not click in when y is greater than 7.5 — Lowpar
– Lowpar, Commented Aug 2, 2016 at 16:13
@Lowpar how is y defined ? are you sure it's getting a numeric value larger than 7.5 ? and not a string showing as 7.5 ? — Shai Rado
– Shai Rado, Commented Aug 2, 2016 at 16:19
@ShaiRado indeed that is a good question, however when I run a =isnumber on a cell with a value it returns a true, in addition the column is formatted as general. — Lowpar
– Lowpar, Commented Aug 2, 2016 at 16:32

Shai Rado · Accepted Answer · 2016-08-02 16:59:16Z

When indenting your code, you have an If without End If, and one Next y too many (see indent code below)

For Each y In rng ' ****** you are not closing this If ***** If Not IsEmpty(y) And y > 7.5 And y <> "" And IsNumeric(y) Then 'I am having trouble here y.Select With ActiveCell.Offset(0, i).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With col = y.Value / 7.5 Count = Left(col, Len(col) - InStr(1, col, ".")) For i = 1 To Count Do While ActiveCell.Offset(0, i).TintAndShade = -0.149998474074526 i = i + 1: Count = Count + 1 Loop ActiveCell.Offset(0, i).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With Next i Count = Right(col, Len(col) - InStr(1, col, ".")) If Count > 0 And Count < 25 Then ActiveCell.TintAndShade = -4.99893185216834E-02 ElseIf Count > 26 And Count < 50 Then ActiveCell.TintAndShade = 0.799981688894314 ElseIf Count > 75 And Count < 100 Then ActiveCell.TintAndShade = 0.599993896298105 End If ' ****** Next y out of place ****** Next y End If Next y

When isolating the problematic section, the following code worked on my data sheet:

Sub test_yRange() Dim rng As Range Dim y As Range Set rng = Worksheets("Sheet1").Range("A1:D5") For Each y In rng ' working now If Not IsEmpty(y) And y > 7.5 And y <> "" And IsNumeric(y) Then ' I am passing the If above when a certain cell has a value of 8 y.Select With ActiveCell.Offset(0, i).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With End If Next y End Sub

Although it was a useful answer, it did not fully answer the question, as for instance ActiveCell.Offset(0, i).TintAndShade = -0.149998474074526 is not a supported property. As a result, the code will not operate correctly.

Collectives™ on Stack Overflow

Colouring multiple cells, in different shades, based on original cell value

1 Answer 1

1 Comment

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Related