Try changing your Worksheet_Change code to:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
ColorMultiCells
End If
End Sub
Then add the following sub to a standard Module:
Option Explicit
Sub ColorMultiCells()
Dim icolor As Integer
Dim oCell As Range
For Each oCell In Selection
Select Case oCell.Value
Case 1
icolor = 6
Case 2
icolor = 12
Case 3
icolor = 7
Case 4
icolor = 53
Case 5
icolor = 15
Case 6
icolor = 42
Case 7
icolor = 1
Case 8
icolor = 20
Case 9
icolor = 30
Case 10
icolor = 40
Case 11
icolor = 51
Case 12
icolor = 14
Case Else
'Whatever
End Select
oCell.Interior.ColorIndex = icolor
Next oCell
End Sub
"TNfisherman" wrote:
> I am trying to auto color cells using this VB code.
>
>
>
> Private Sub Worksheet_Change(ByVal Target As Range)
> Dim icolor As Integer
>
> If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
> Select Case Target
> Case 1
> icolor = 6
> Case 2
> icolor = 12
> Case 3
> icolor = 7
> Case 4
> icolor = 53
> Case 5
> icolor = 15
> Case 6
> icolor = 42
> Case 7
> icolor = 1
> Case 8
> icolor = 20
> Case 9
> icolor = 30
> Case 10
> icolor = 40
> Case 11
> icolor = 51
> Case 12
> icolor = 14
>
> Case Else
> 'Whatever
> End Select
>
> Target.Interior.ColorIndex = icolor
> End If
>
> End Sub
>
> The problem I am having is I have to either hard code in data to change the
> color of the cell or I can only copy data into cells one cell at a time to
> change the color. What I would like to do is copy data that is on multiple
> rows and past it to the work sheet with the VB code and have all of those
> cells auto color to my specified colors. I am getting a Debug error stating
> "Run time error '13' Type Mismatch" Any help will be greatly appreciated.
>
>
>
>
|