Worksheet_Selection Change code will not allow cell contents to be copied and pasted onto the sheet it's running on
 

Hi

I'm running the following code to create a unqiue list of codes on the
previous worksheet.
The codes are listed in cell A8:A1000 on the active worksheet and the list
is created on the previous worksheet in cells A13:A100

It's working good.. except.. I cannot copy and paste any cells contents on
the active worksheet.
I select a cell, select copy.. it copies the cell (dotted lines blink around
the cell) , and when I click out of that cell into another one.. the paste
option is not available and the dotted lines..
I can copy data in a cell on the activeworksheet and paste it to a different
worksheet.. and I can paste data from a different worksheet into a cell on
this activeworksheet.
It's only when I copy data from this sheet and try to paste it to this
sheet.

What is causing this...?? Is there something I can add to the code to
correct this...


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim prevSheet As Worksheet

With Me
If .Index = 1 Then
MsgBox "No sheets to the left"
Set prevSheet = Worksheets("Adjustments")
Else
Set prevSheet = Worksheets(.Index - 1)
End If

.Unprotect Password:="test"
If Not Application.Intersect(Target, _
Range("A8:A1000")) Is Nothing Then
prevSheet.Unprotect Password:="test"
prevSheet.Range("A13:A100").ClearContents
prevSheet.Unprotect Password:="test"
gCopyUnique Range("A8:A1000"), prevSheet.Range("A13")
End If
.Unprotect Password:="test"
'Range("R16:R51").Select
prevSheet.Unprotect Password:="test"
prevSheet.Range("A13:A47").Sort , _
Key1:=prevSheet.Range("A13"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
.Protect Password:="test", DrawingObjects:=True, _
Contents:=True, Scenarios:=True

End With
prevSheet.Protect Password:="test", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Application.ScreenUpdating = Ture
End Sub
****************

Public Sub gCopyUnique(rrngSource As Range, rrngDest As Range)

ActiveSheet.Unprotect Password:="test"
rrngSource.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=rrngDest, Unique:=True
ActiveSheet.Protect Password:="test", DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub


As always.. Thanks in advance for you help!!
Kimberly

Worksheet_Selection Change code will not allow cell contents to be copied and pasted onto the sheet it's running on
 

Most macro commands that affect the sheet, when executed, cause the
clipboard to be cleared if the item copied is a range. I assume you code is
running and causing the clipboard to be cleare.

--
regards,
Tom Ogilvy



"KimberlyC" wrote in message
...
Hi

I'm running the following code to create a unqiue list of codes on the
previous worksheet.
The codes are listed in cell A8:A1000 on the active worksheet and the list
is created on the previous worksheet in cells A13:A100

It's working good.. except.. I cannot copy and paste any cells contents on
the active worksheet.
I select a cell, select copy.. it copies the cell (dotted lines blink
around
the cell) , and when I click out of that cell into another one.. the paste
option is not available and the dotted lines..
I can copy data in a cell on the activeworksheet and paste it to a
different
worksheet.. and I can paste data from a different worksheet into a cell on
this activeworksheet.
It's only when I copy data from this sheet and try to paste it to this
sheet.

What is causing this...?? Is there something I can add to the code to
correct this...


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim prevSheet As Worksheet

With Me
If .Index = 1 Then
MsgBox "No sheets to the left"
Set prevSheet = Worksheets("Adjustments")
Else
Set prevSheet = Worksheets(.Index - 1)
End If

.Unprotect Password:="test"
If Not Application.Intersect(Target, _
Range("A8:A1000")) Is Nothing Then
prevSheet.Unprotect Password:="test"
prevSheet.Range("A13:A100").ClearContents
prevSheet.Unprotect Password:="test"
gCopyUnique Range("A8:A1000"), prevSheet.Range("A13")
End If
.Unprotect Password:="test"
'Range("R16:R51").Select
prevSheet.Unprotect Password:="test"
prevSheet.Range("A13:A47").Sort , _
Key1:=prevSheet.Range("A13"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
.Protect Password:="test", DrawingObjects:=True, _
Contents:=True, Scenarios:=True

End With
prevSheet.Protect Password:="test", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Application.ScreenUpdating = Ture
End Sub
****************

Public Sub gCopyUnique(rrngSource As Range, rrngDest As Range)

ActiveSheet.Unprotect Password:="test"
rrngSource.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=rrngDest, Unique:=True
ActiveSheet.Protect Password:="test", DrawingObjects:=True,
Contents:=True,
Scenarios:=True

End Sub


As always.. Thanks in advance for you help!!
Kimberly