Error.. feature is no longer functioning properly

[fredk]

I have some code that changes the colors of fonts of fields depending on their value - I am no expert on doing this - everything was working fine and actually still works ok until I try to save the file - Every time I save the file I get a message box that states "an error occurred and this feature is no longer functioning properly, would you like to repair this feature" I then select ok and get a pop up box that says "Internal Error 2709...." I click ok and get another pop up box that says "Microsoft Excel cannot install the necessary files due to windows installer error 1603 Fatal error during installation"

I have no idea? Any help would be greatly appreciated!!!

Here is the code I have.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
' FormatTiers Macro
' Macro recorded 10/4/2005 by Fred
'
' Keyboard Shortcut: Ctrl+f
'This macro changes font of all columns depending on bonus area
'(i.e. efficiency, production) according to the bonus tier of each
Dim I As Integer
Dim X As Integer
Dim Y As Integer
Dim P As Integer
Dim Z As Integer

I = 7

'changes color of font for efficiency columns
Do
If (Cells(I, "D").Value = 1) Then
Cells(I, "C").Font.Color = RGB(153, 51, 102)
Cells(I, "D").Font.Color = RGB(153, 51, 102)
ElseIf (Cells(I, "D").Value = 2) Then
Cells(I, "C").Font.Color = RGB(0, 128, 128)
Cells(I, "D").Font.Color = RGB(0, 128, 128)
ElseIf (Cells(I, "D").Value = 3) Then
Cells(I, "C").Font.Color = RGB(0, 128, 0)
Cells(I, "D").Font.Color = RGB(0, 128, 0)
Else
Cells(I, "C").Font.Color = RGB(255, 0, 0)
Cells(I, "D").Font.Color = RGB(255, 0, 0)
End If

I = I + 1

Loop Until I = 38


X = 7

'changes color of font for new business
Do
If (Cells(X, "H").Value = 1) Then
Cells(X, "G").Font.Color = RGB(153, 51, 102)
Cells(X, "H").Font.Color = RGB(153, 51, 102)
ElseIf (Cells(X, "H").Value = 2) Then
Cells(X, "G").Font.Color = RGB(0, 128, 128)
Cells(X, "H").Font.Color = RGB(0, 128, 128)
ElseIf (Cells(X, "H").Value = 3) Then
Cells(X, "G").Font.Color = RGB(0, 128, 0)
Cells(X, "H").Font.Color = RGB(0, 128, 0)
Else
Cells(X, "G").Font.Color = RGB(255, 0, 0)
Cells(X, "H").Font.Color = RGB(255, 0, 0)
End If

X = X + 1

Loop Until X = 38


Y = 7
'changes color of font for persistency

Do
If (Cells(Y, "M").Value = 1) Then
Cells(Y, "L").Font.Color = RGB(153, 51, 102)
Cells(Y, "M").Font.Color = RGB(153, 51, 102)
ElseIf (Cells(Y, "M").Value = 2) Then
Cells(Y, "L").Font.Color = RGB(0, 128, 128)
Cells(Y, "M").Font.Color = RGB(0, 128, 128)
ElseIf (Cells(Y, "M").Value = 3) Then
Cells(Y, "L").Font.Color = RGB(0, 128, 0)
Cells(Y, "M").Font.Color = RGB(0, 128, 0)
Else
Cells(Y, "L").Font.Color = RGB(255, 0, 0)
Cells(Y, "M").Font.Color = RGB(255, 0, 0)
End If

Y = Y + 1

Loop Until Y = 38

P = 7
'changes color of font for overall tier and bonus dollars
Do
If (Cells(P, "N").Value = 1) Then
Cells(P, "N").Font.Color = RGB(153, 51, 102)
Cells(P, "N").Interior.Color = vbYellow
Cells(P, "N").Borders.Color = RGB(0, 0, 255)
Cells(P, "O").Font.Color = RGB(153, 51, 102)
Cells(P, "O").Interior.Color = vbYellow
Cells(P, "O").Borders.Color = RGB(0, 0, 255)
ElseIf (Cells(P, "N").Value = 2) Then
Cells(P, "N").Font.Color = RGB(0, 128, 128)
Cells(P, "N").Interior.Color = vbYellow
Cells(P, "N").Borders.Color = RGB(0, 0, 255)
Cells(P, "O").Font.Color = RGB(0, 128, 128)
Cells(P, "O").Interior.Color = vbYellow
Cells(P, "O").Borders.Color = RGB(0, 0, 255)
ElseIf (Cells(P, "N").Value = 3) Then
Cells(P, "N").Font.Color = RGB(0, 128, 0)
Cells(P, "N").Interior.Color = vbYellow
Cells(P, "N").Borders.Color = RGB(0, 0, 255)
Cells(P, "O").Font.Color = RGB(0, 128, 0)
Cells(P, "O").Interior.Color = vbYellow
Cells(P, "O").Borders.Color = RGB(0, 0, 255)
Else
Cells(P, "N").Font.Color = RGB(255, 0, 0)
Cells(P, "N").Interior.Color = RGB(128, 128, 0)
Cells(P, "N").Borders.Color = RGB(0, 0, 0)
Cells(P, "o").Font.Color = RGB(255, 0, 0)
Cells(P, "o").Interior.Color = RGB(128, 128, 0)
Cells(P, "o").Borders.Color = RGB(0, 0, 0)

End If

P = P + 1

Loop Until P = 38


End Sub