Logo 
Search:

MS Office Forum

 Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

This code does not work if i copy & paste above one cell

  Asked By: Francisca    Date: Jan 07    Category: MS Office    Views: 4926
  

The code which i have does not work if i paste from another range
(range of 2 cells and above).But if i paste a single cell it works or
i have to type manually one cell after the other. what do i do so
that i can copy from another bigger range patste it in my range
A1:D72 to get the color effect.?


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim WatchRange As Range
Dim CellVal As Integer
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Or Not IsNumeric(Target) Then Exit Sub
CellVal = Target
Set WatchRange = Range("A1:D72")

If Not Intersect(Target, WatchRange) Is Nothing Then
Select Case CellVal
Case 0
Target.Interior.ColorIndex = 5
Case 1
Target.Interior.ColorIndex = 10
Case 2
Target.Interior.ColorIndex = 6
Case 3
Target.Interior.ColorIndex = 46
Case 4
Target.Interior.ColorIndex = 45
Case 5
Target.Interior.ColorIndex = 5
Case 6
Target.Interior.ColorIndex = 10
Case 7
Target.Interior.ColorIndex = 6
Case 8
Target.Interior.ColorIndex = 46
Case 9
Target.Interior.ColorIndex = 45

End Select
End If
End Sub

Share: 

 

2 Answers Found

 
Answer #1    Answered By: Devrim Yilmaz     Answered On: Jan 07

I suspect it is because of the following line:

If Target.Cells.Count > 1 Then Exit Sub

That says, If you have a range  selected of more than one cell, then
don't perform the operation.

 
Answer #2    Answered By: Hababah Younis     Answered On: Jan 07

This will do it:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim WatchRange As Range
Dim CellVal As Integer
For Each targ In Target.Cells

If targ = "" Or Not IsNumeric(targ) Then Exit Sub
CellVal = targ
Set WatchRange = Range("A1:c52")

If Not Intersect(targ, WatchRange) Is Nothing Then
Select Case CellVal
Case 0
targ.Interior.ColorIndex = 5
Case 1
targ.Interior.ColorIndex = 10
Case 2
targ.Interior.ColorIndex = 6
Case 3
targ.Interior.ColorIndex = 46
Case 4
targ.Interior.ColorIndex = 45
Case 5
targ.Interior.ColorIndex = 5
Case 6
targ.Interior.ColorIndex = 10
Case 7
targ.Interior.ColorIndex = 6
Case 8
targ.Interior.ColorIndex = 46
Case 9
targ.Interior.ColorIndex = 45
End Select
End If
Next targ
End Sub

 
Didn't find what you were looking for? Find more on This code does not work if i copy & paste above one cell Or get search suggestion and latest updates.




Tagged:          

 
 
 
 

Related Post