Selection Change Event

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

When I use the selection change event, if I have copied a range of cells and
move to a new location, I lose the copied data (same as cutcopymode = false).
Is there a way to maintain the copied data to be pasted to the new location?
 
Hi Jim,

I've had the same problem. In my situation i copied a range, unprotected the
destination sheet, and tried to paste the range, but it was gone.
I took care of it by first do the unprotect, copy the range and paste it.
After this i protected the sheet.

In your code, do you also unprotect before the paste action? Otherwise maybe
some other actions have the same effect on the copied range.

Rody
 
I am using the change event and that is what is causing the difficulty... The
firing of the event is what is causing the CutCopyMode to be switched to
false so I have no options here. Here is my code if you want to play with it.
It consists of a Class and a module. The class is designed to catch the event
and the module instantiates the class when the spreadsheet is opened. The
purpose of the code is to change the font colour of the entire rows of the
selected cells to red and then back to black when the activecell changes.
Here is the class:

'clsHighlightRows
Option Explicit
Private HighlightSheets As New Collection
Private WithEvents xlApp As Excel.Application
Private rngOldTarget As Range

Private Sub Class_Initialize()
Set xlApp = Excel.Application
End Sub

Private Sub Class_Terminate()
Set xlApp = Nothing
Set HighlightSheets = Nothing
End Sub

Private Sub xlApp_SheetActivate(ByVal Sh As Object)
'Initialize the last cell to the current cell of this sheet
Set rngOldTarget = ActiveCell

'Highlight the Font of the current cell if necessary
Call xlApp_SheetSelectionChange(Sh, rngOldTarget)

End Sub

Private Sub xlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As
Range)
Dim wks As Worksheet

On Error Resume Next
Set wks = HighlightSheets.Item(Sh.Name)
On Error GoTo 0

If Not wks Is Nothing Then Call HighlightRow(Sh, Target)
End Sub


Public Function AddSheet(ByVal wks As Worksheet)
Call HighlightSheets.Add(wks, wks.Name)
End Function

Public Function RemoveSheet(ByVal wks As Worksheet)
Call HighlightSheets.Remove(wks.Name)
End Function

Public Property Get Items() As Collection
Set Items = HighlightSheets
End Property

Private Sub HighlightRow(ByVal Sh As Object, ByVal Target As Range)

If Not (rngOldTarget Is Nothing) Then
'Change the old row font colour back to Black
rngOldTarget.EntireRow.Font.ColorIndex = 1 'Black Font
End If
'Set Last cell = Current cell
Set rngOldTarget = Target
Target.EntireRow.Font.ColorIndex = 3 'Change to Red Font

End Sub

And here is the module...

Option Explicit

Public HighlightRow As clsHighlightRows

Public Sub Auto_Open()
Set HighlightRow = New clsHighlightRows

HighlightRow.AddSheet Sheet1
HighlightRow.AddSheet Sheet2

End Sub

Public Sub Auto_Close()
Set HighlightRow = Nothing
End Sub

Add these to a new workbook. Put some text in the sheets and then just move
around... The rows of the selected cells will have red font. It works great
except that I can not copy and paste with this code attached to a sheet.

Rody said:
Hi Jim,

I've had the same problem. In my situation i copied a range, unprotected the
destination sheet, and tried to paste the range, but it was gone.
I took care of it by first do the unprotect, copy the range and paste it.
After this i protected the sheet.

In your code, do you also unprotect before the paste action? Otherwise maybe
some other actions have the same effect on the copied range.

Rody
Click to expand...
 
Hi Jim,

This is a nice one, but to difficult for me. The changing of the font color
causes the "loss" of the clipboard content, (cutcopymode = false)
I tried to work around it by somthing like:

Private Sub HighlightRow(ByVal Sh As Object, ByVal Target As Range)
'' if a range is selected, copy the content of the clipboard to the next
selected cel

If Application.CutCopyMode Then ActiveSheet.Paste '' or something like
this

If Not (rngOldTarget Is Nothing) Then
'Change the old row font colour back to Black
rngOldTarget.EntireRow.Font.ColorIndex = 1 'Black Font
End If
'Set Last cell = Current cell
Set rngOldTarget = Target
Target.EntireRow.Font.ColorIndex = 3 'Change to Red Font

End Sub

But this won't give a satisfiing result. I'm sorry, this is a bit to
""heavy"..............

Rody




Jim Thomlinson said:
I am using the change event and that is what is causing the difficulty...
The
firing of the event is what is causing the CutCopyMode to be switched to
false so I have no options here. Here is my code if you want to play with
it.
It consists of a Class and a module. The class is designed to catch the
event
and the module instantiates the class when the spreadsheet is opened. The
purpose of the code is to change the font colour of the entire rows of the
selected cells to red and then back to black when the activecell changes.
Here is the class:

'clsHighlightRows
Option Explicit
Private HighlightSheets As New Collection
Private WithEvents xlApp As Excel.Application
Private rngOldTarget As Range

Private Sub Class_Initialize()
Set xlApp = Excel.Application
End Sub

Private Sub Class_Terminate()
Set xlApp = Nothing
Set HighlightSheets = Nothing
End Sub

Private Sub xlApp_SheetActivate(ByVal Sh As Object)
'Initialize the last cell to the current cell of this sheet
Set rngOldTarget = ActiveCell

'Highlight the Font of the current cell if necessary
Call xlApp_SheetSelectionChange(Sh, rngOldTarget)

End Sub

Private Sub xlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As
Range)
Dim wks As Worksheet

On Error Resume Next
Set wks = HighlightSheets.Item(Sh.Name)
On Error GoTo 0

If Not wks Is Nothing Then Call HighlightRow(Sh, Target)
End Sub


Public Function AddSheet(ByVal wks As Worksheet)
Call HighlightSheets.Add(wks, wks.Name)
End Function

Public Function RemoveSheet(ByVal wks As Worksheet)
Call HighlightSheets.Remove(wks.Name)
End Function

Public Property Get Items() As Collection
Set Items = HighlightSheets
End Property

Private Sub HighlightRow(ByVal Sh As Object, ByVal Target As Range)

If Not (rngOldTarget Is Nothing) Then
'Change the old row font colour back to Black
rngOldTarget.EntireRow.Font.ColorIndex = 1 'Black Font
End If
'Set Last cell = Current cell
Set rngOldTarget = Target
Target.EntireRow.Font.ColorIndex = 3 'Change to Red Font

End Sub

And here is the module...

Option Explicit

Public HighlightRow As clsHighlightRows

Public Sub Auto_Open()
Set HighlightRow = New clsHighlightRows

HighlightRow.AddSheet Sheet1
HighlightRow.AddSheet Sheet2

End Sub

Public Sub Auto_Close()
Set HighlightRow = Nothing
End Sub

Add these to a new workbook. Put some text in the sheets and then just
move
around... The rows of the selected cells will have red font. It works
great
except that I can not copy and paste with this code attached to a sheet.
Click to expand...
 
Back
Top