Need to loop thru cells and change background color

  • Thread starter Thread starter Ian Wolstenholme
  • Start date Start date
I

Ian Wolstenholme

Hi,

I want to loop through a range of cells starting at D5 and then going as far
to the right and down the spreadsheet as there are values in the sheet.

For each cell I want to be able to color code the background of the cells
depending upon the following criteria

Cell contains 0h Cell colour is white
Cell contains >0h but less than 8h Cell colour is Yellow
Cell contains 8h Cell colour is Orange
Cell contains greated than 8h Cell colour is Red

But I also want to ignore the cells in the last two rows and the farthest
populated column of the spreadsheet as

The spreadhseet can be a different size each time it is generated so the
code must accomodate this.

I am sure this is fairly straight forward but I'm a bit of a newbie to this,
so was hoing someone could help me out here.

Many Thanks

Regards

Ian
 
Ian,

Sub FormatTable()
Dim Table As Range, Datum As Range
Set Table = Range(Range(Range("D5"), Range("D5").End(xlDown)),
Range(Range("D5"), Range("D5").End(xlToRight)))
Table.Interior.ColorIndex = xlNone ' reset to white
' less last two rows and last column:
Set Table = Table.Resize(Table.Rows.Count - 2, Table.Columns.Count - 1)
For Each Datum In Table
If Datum = 0 Then
Datum.Interior.ColorIndex = xlNone ' no color
ElseIf Datum > 0 And Datum < 8 Then
Datum.Interior.ColorIndex = 6 ' yellow
ElseIf Datum = 8 Then
Datum.Interior.ColorIndex = 44 ' orange
ElseIf Datum > 8 Then
Datum.Interior.ColorIndex = 3 ' red
End If
Next Datum
End Sub

Sorry about all that Range mess in the first Set Table statement. There's
probably a cleaner way. I'm out of coffee.
 
Hi Earl,

I really appreciate your help !

The macro looked just the ticket - until I tried it and it coloured all the
cells in the range red.

Within the cell range I have 8h, 0h, 4h, etc.

So it would appear that the macro doesn't recognse the "h" after each
number. How would I account for this ?

Many Thanks

Ian
 
Sub FormatTable()
Dim Table As Range, Datum As Range
Set Table = Range(Range(Range("D5"), Range("D5").End(xlDown)),
Range(Range("D5"), Range("D5").End(xlToRight)))
Table.Interior.ColorIndex = xlNone ' reset to white
' less last two rows and last column:
Set Table = Table.Resize(Table.Rows.Count - 2, Table.Columns.Count - 1)
For Each Datum In Table
If Datum = "0h" Then
Datum.Interior.ColorIndex = xlNone ' no color
ElseIf Datum > "0h" And Datum < "8h" Then
Datum.Interior.ColorIndex = 6 ' yellow
ElseIf Datum = "8h" Then
Datum.Interior.ColorIndex = 44 ' orange
ElseIf Datum > "8h" Then
Datum.Interior.ColorIndex = 3 ' red
End If
Next Datum
End Sub
 
Ian,

I meant to ask you about 0h, etc. It appeared that maybe you're one of
those heavy types who dreams in hex! :) Let's try this:

Sub FormatTable()
Dim Table As Range, Datum As Range
Dim TestVal
Set Table = Range(Range(Range("D5"), Range("D5").End(xlDown)),
Range(Range("D5"), Range("D5").End(xlToRight)))
Table.Interior.ColorIndex = xlNone ' reset to white
' less last two rows and last column:
Set Table = Table.Resize(Table.Rows.Count - 2, Table.Columns.Count - 1)
For Each Datum In Table
TestVal = Mid(Datum.Value, 1, Len(Datum) - 1)
If TestVal = 0 Then
Datum.Interior.ColorIndex = xlNone ' no color
ElseIf TestVal > 0 And TestVal < 8 Then
Datum.Interior.ColorIndex = 6 ' yellow
ElseIf TestVal = 8 Then
Datum.Interior.ColorIndex = 44 ' orange
ElseIf TestVal > 8 Then
Datum.Interior.ColorIndex = 3 ' red
End If
Next Datum
End Sub
 
Hi Earl,

Its not hex - the h stands for hours !

But the code worked perfectly - Thank you so much. I am very grateful !!

Regards

Ian
 
Hi Tom,

This code worked in part, but the values above 8h won't change the cell
colour to red.

Thanks anyway for your efforts. Earl's code did the trick.

With grateful thanks.

Regards

Ian
 
Back
Top