Linc,

If you set the colour of a cell, it obliterates the gridlines unfortunately.

You could put a border around those cells.

Private Sub Worksheet_Calculate()

Application.ScreenUpdating = False

For y = 4 To 38
Cells(y, 10).Select
A_Done = Cells(y, 10)
If A_Done = "x" Then
' Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
ActiveCell.Select
With Selection
Interior.ColorIndex = 4
' .Interior.Pattern = xlSolid
Font.ColorIndex = 4
End With
ElseIf A_Done = "o" Then
' Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
ActiveCell.Select
With Selection
Interior.ColorIndex = 2
' .Interior.Pattern = xlSolid
Font.ColorIndex = 2
End With
AddBorders Selection
End If
Next y

Application.ScreenUpdating = True

End Sub

Sub AddBorders(rng As Range)
With rng
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End Sub



--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Linc" wrote in message
...

The followin is what I am working on. What I don't like
is that it removes the grid lines. What do I change so that
when the cells are blank formated the gridlines still show?

Private Sub Worksheet_Calculate()

Application.ScreenUpdating = False

For y = 4 To 38
Cells(y, 10).Select
A_Done = Cells(y, 10)
If A_Done = "x" Then
' Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
ActiveCell.Select
With Selection
Interior.ColorIndex = 4
' .Interior.Pattern = xlSolid
Font.ColorIndex = 4
End With
ElseIf A_Done = "o" Then
' Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
ActiveCell.Select
With Selection
Interior.ColorIndex = 2
' .Interior.Pattern = xlSolid
Font.ColorIndex = 2
End With
End If
Next y

Application.ScreenUpdating = True

End Sub


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from http://www.ExcelForum.com/