Run Time Error 13- Type mismatch

[Ram B]

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
---------------------------------------------------------------------------

 

[JLGWhiz]

I'm not getting the message. It works on my system. I put the code behind
Sheet1 and entered various color names, x, xx and nothing in column F and all
performed as expected.

 

[JLGWhiz]

When you are dragging from another range, you are also bringing that source
cell's format with it. That could be the cause of the type mismatch.

 

[Chip Pearson]

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]

Thanks- it worked

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)