Try the following modified code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
Dim R As Range
If Not Intersect(Target, Range("F1:F400")) Is Nothing Then
Application.EnableEvents = False
For Each R In Target.Cells
Select Case R.Text
Case "Red": icolor = 3
Case "Green": icolor = 4
Case "Blue": icolor = 5
Case "White": icolor = 2
Case "Gray": icolor = 15
Case "x": icolor = 1
Case "xx": icolor = 40
Case Else: 'Whatever
End Select
R.Interior.ColorIndex = icolor
R.Font.ColorIndex = icolor
Next R
End If
EndProc:
Application.EnableEvents = True
End Sub
--
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
"Ram B" wrote in message
...
I have the following conditional formatting VB code in my worksheet. The
code
works does what it need to do except when I drag and copy cells or when I
copy and paste in subsiquent cells selected by draging. I get the "Run
Time
Error 13- Type mismatch".
------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
If Not Intersect(Target, Range("F1:F400")) Is Nothing Then
Select Case Target
Case "Red": icolor = 3
Case "Green": icolor = 4
Case "Blue": icolor = 5
Case "White": icolor = 2
Case "Gray": icolor = 15
Case "x": icolor = 1
Case "xx": icolor = 40
Case Else: 'Whatever
End Select
Target.Interior.ColorIndex = icolor
Target.Font.ColorIndex = icolor
End If
End Sub
---------------------------------------------------------------------------