function work with manual update, fails with copy paste 1 cell
 

Hi,

I have a function to set up the color of a cell based on the value input by
the user. It does work perfectly when a user enters a value, but it fails
when the user copy a value in a cell and paste it over more than one cell at
a time.

function:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target = "H" Then
Target.Interior.ColorIndex = 4
End If

If Target = "h" Then
Target.Interior.ColorIndex = 43
End If

If Target = "S" Then
Target.Interior.ColorIndex = 27
End If

If Target = "s" Then
Target.Interior.ColorIndex = 36
End If

If Target = "t" Then
Target.Interior.ColorIndex = 45
End If

If Target = "T" Then
Target.Interior.ColorIndex = 46
End If

End Sub

Error message:Type mismatch, located at If Target = "H" Then.

I can t use conditional formatting because I want to extend this function to
other topics (sum, ...).
Is there a way to make this function working with copy paste over more 1
cell ?

Rds
Marcello

function work with manual update, fails with copy paste 1 cell
 

On Dec 23, 11:45*am, marcello121
wrote:
Hi,

I have a function to set up the color of a cell based on the value input by
the user. It does work perfectly when a user enters a value, but it fails
when the user copy a value in a cell and paste it over more than one cell at
a time.

function:

Private Sub Worksheet_Change(ByVal Target As Range)

* If Target = "H" Then
* * Target.Interior.ColorIndex = 4
* End If

* If Target = "h" Then
* * Target.Interior.ColorIndex = 43
* End If

* If Target = "S" Then
* * Target.Interior.ColorIndex = 27
* End If

* If Target = "s" Then
* * Target.Interior.ColorIndex = 36
* End If

* If Target = "t" Then
* * Target.Interior.ColorIndex = 45
* End If

* If Target = "T" Then
* * Target.Interior.ColorIndex = 46
* End If

End Sub

Error message:Type mismatch, located at If Target = "H" Then.

I can t use conditional formatting because I want to extend this function to
other topics (sum, ...).
Is there a way to make this function working with copy paste over more 1
cell ?

Rds
Marcello


You can use a error haldler like this:


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrorHandler

If Target = "H" Then
Target.Interior.ColorIndex = 4
End If


If Target = "h" Then
Target.Interior.ColorIndex = 43
End If


If Target = "S" Then
Target.Interior.ColorIndex = 27
End If


If Target = "s" Then
Target.Interior.ColorIndex = 36
End If


If Target = "t" Then
Target.Interior.ColorIndex = 45
End If


If Target = "T" Then
Target.Interior.ColorIndex = 46
End If

ErrorHandler: ' Error-handling routine.
End Sub

function work with manual update, fails with copy paste 1 cell
 

You are comparing Target (a range) with some text string. Better to use
something like:

Private Sub Worksheet_Change(ByVal Target As Range)
Set r = Range("H:H")
If Intersect(Target, r) Is Nothing Then Exit Sub
Target.Interior.ColorIndex = 4
End Sub
--
Gary''s Student - gsnu200909


"marcello121" wrote:

Hi,

I have a function to set up the color of a cell based on the value input by
the user. It does work perfectly when a user enters a value, but it fails
when the user copy a value in a cell and paste it over more than one cell at
a time.

function:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target = "H" Then
Target.Interior.ColorIndex = 4
End If

If Target = "h" Then
Target.Interior.ColorIndex = 43
End If

If Target = "S" Then
Target.Interior.ColorIndex = 27
End If

If Target = "s" Then
Target.Interior.ColorIndex = 36
End If

If Target = "t" Then
Target.Interior.ColorIndex = 45
End If

If Target = "T" Then
Target.Interior.ColorIndex = 46
End If

End Sub

Error message:Type mismatch, located at If Target = "H" Then.

I can t use conditional formatting because I want to extend this function to
other topics (sum, ...).
Is there a way to make this function working with copy paste over more 1
cell ?

Rds
Marcello

function work with manual update, fails with copy paste 1 cell
 

Hi,

Include this line at the start of your code

If Target.Cells.Count 1 Then Exit Sub

Mike

"marcello121" wrote:

Hi,

I have a function to set up the color of a cell based on the value input by
the user. It does work perfectly when a user enters a value, but it fails
when the user copy a value in a cell and paste it over more than one cell at
a time.

function:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target = "H" Then
Target.Interior.ColorIndex = 4
End If

If Target = "h" Then
Target.Interior.ColorIndex = 43
End If

If Target = "S" Then
Target.Interior.ColorIndex = 27
End If

If Target = "s" Then
Target.Interior.ColorIndex = 36
End If

If Target = "t" Then
Target.Interior.ColorIndex = 45
End If

If Target = "T" Then
Target.Interior.ColorIndex = 46
End If

End Sub

Error message:Type mismatch, located at If Target = "H" Then.

I can t use conditional formatting because I want to extend this function to
other topics (sum, ...).
Is there a way to make this function working with copy paste over more 1
cell ?

Rds
Marcello

function work with manual update, fails with copy paste 1 ce
 

Thanks. The error handler and the tip If Target.Cells.Count 1 Then Exit Sub
enable to avoid the error message. To enable the copy-paste, I separated the
process in 2 functions:
- one to collect the range of cells affected by the copy paste, and review
each cell separately
- one function to 'process' each cell (format, ...)

Not beautiful code because I m not an Excel specialist, I do prefer
MSAccess, but it does work.

Many thanks for your help.


"Master Blaster" wrote:

On Dec 23, 11:45 am, marcello121
wrote:
Hi,

I have a function to set up the color of a cell based on the value input by
the user. It does work perfectly when a user enters a value, but it fails
when the user copy a value in a cell and paste it over more than one cell at
a time.

function:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target = "H" Then
Target.Interior.ColorIndex = 4
End If

If Target = "h" Then
Target.Interior.ColorIndex = 43
End If

If Target = "S" Then
Target.Interior.ColorIndex = 27
End If

If Target = "s" Then
Target.Interior.ColorIndex = 36
End If

If Target = "t" Then
Target.Interior.ColorIndex = 45
End If

If Target = "T" Then
Target.Interior.ColorIndex = 46
End If

End Sub

Error message:Type mismatch, located at If Target = "H" Then.

I can t use conditional formatting because I want to extend this function to
other topics (sum, ...).
Is there a way to make this function working with copy paste over more 1
cell ?

Rds
Marcello


You can use a error haldler like this:


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrorHandler

If Target = "H" Then
Target.Interior.ColorIndex = 4
End If


If Target = "h" Then
Target.Interior.ColorIndex = 43
End If


If Target = "S" Then
Target.Interior.ColorIndex = 27
End If


If Target = "s" Then
Target.Interior.ColorIndex = 36
End If


If Target = "t" Then
Target.Interior.ColorIndex = 45
End If


If Target = "T" Then
Target.Interior.ColorIndex = 46
End If

ErrorHandler: ' Error-handling routine.
End Sub
.