If I interpretted your code correctly this should work

Sub Add_Colour(
Range("A2").Selec
Application.ScreenUpdating = Fals

D
ActiveCell.Offset(0, 2).Activat
If ActiveCell = "a" Then myColor = 3
If ActiveCell = "b" Then myColor = 3
If ActiveCell = "c" Then myColor = 3
If ActiveCell = "d" Then myColor = 3
If ActiveCell < "a" And ActiveCell < "b" And ActiveCell < "c" An
ActiveCell < "d" The
MsgBox "The ActiveCell does not equal any of the choices.
Exit Su
End I

If IsEmpty(ActiveCell) Then Exit Su
' ignore error if activecell is in Column
On Error Resume Nex
If IsEmpty(ActiveCell.Offset(0, -1)) Then Set LeftCell = ActiveCel
Else Set LeftCell = ActiveCell.End(xlToLeft
If IsEmpty(ActiveCell.Offset(0, 1)) Then Set RightCell = ActiveCel
Else Set RightCell = ActiveCell.End(xlToRight
Range(LeftCell, RightCell).Selec

With Selection.Interio
.ColorIndex = myColo
End Wit

ActiveCell.Offset(1, 0).Range("A1").Selec
Loop Until IsEmpty(ActiveCell

Application.ScreenUpdating = Tru
End Su

Hope that's what you needed

-Ikaabo

--
Ikaabo
-----------------------------------------------------------------------
Ikaabod's Profile: http://www.excelforum.com/member.php...fo&userid=3337
View this thread: http://www.excelforum.com/showthread.php?threadid=53611