Cell Shading Problems

[Claude-CB]

Hi there,

I am using excel to set up a simple program for some activities I am doing over the next month or so (see attached). I have created the code below (with the assistance of previous threads, help sites) to aid the shading of cells and font using the case function - the case functions as presented below. I still have two problems that I can live with, but would really like to avoid if I can:
- If I delete contents or cut an paste values I get an error "'run time error type 13 - TYpe mismatch'
- is there a way to leave a cell color shading as it was, ie the shading was manually formatted (not via the case function)

I am a VBA gumby and rely on other people's assistance. Once again, it would be great if someone out there can help me out.

The Code is located in the worksheet:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
If Not Intersect(Target, Range("C3:AZ50")) Is Nothing Then
Select Case Target
Case "N/A"
icolor = 3
Target.Font.ColorIndex = 3
Case "A"
icolor = 4
Target.Font.ColorIndex = 4
Case "WE"
icolor = 15
Target.Font.ColorIndex = 15
Case "PH"
icolor = 18
Target.Font.ColorIndex = 18
Case "B"
icolor = 1
Target.Font.ColorIndex = 1
Case "?"
icolor = 27
Case "T"
Target.Font.ColorIndex = 26
icolor = 26
Case "Maint"
icolor = 3
End Select
Target.Interior.ColorIndex = icolor
'Is there a way to leave the shading that was already in the cell as it was rather than being reset?
'When I drag cells to fill (with contents not matched to the case conditions above) or clear cells in row 3 to7, I get an 'run time error type 13 - TYpe mismatch'. Is there a way of avoiding this?
End If
End Sub

The 'Refresh' code I have in my macros (I use this if I have made a number of changes and this is the macro that modifies my 'manual shading', cells I3:I4).

Public Sub Refresh()
For Each C In Worksheets("Program").Range("C3:AA150")
C.Value = C.Value
Next C
End Sub

[HansV]

Hi Claude,

Welcome to Eileen's Lounge!

The error message occurs when the Target is more than one cell. In that situation, the "value" of Target is not defined. You have to loop through the cells:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim iColor As Integer
  Dim oCell As Range
  If Not Intersect(Target, Range("C3:AZ50")) Is Nothing Then
    For Each oCell In Intersect(Target, Range("C3:AZ50"))
      Select Case oCell
        Case "N/A"
          iColor = 3
          oCell.Font.ColorIndex = 3
        Case "A"
          iColor = 4
          oCell.Font.ColorIndex = 4
        Case "WE"
          iColor = 15
          oCell.Font.ColorIndex = 15
        Case "PH"
          iColor = 18
          oCell.Font.ColorIndex = 18
        Case "B"
          iColor = 1
          oCell.Font.ColorIndex = 1
        Case "?"
          iColor = 27
        Case "T"
          iColor = 26
          oCell.Font.ColorIndex = 26
        Case "Maint"
          iColor = 3
      End Select
      oCell.Interior.ColorIndex = iColor
    Next oCell
  End If
End Sub

About leaving shading the way it was: VBA cannot distinguish between shading applied manually and shading applied by code. But if you manually only apply colors that are not in the set used by the Worksheet_Change event, you could have the code check for that. Would that be feasible?