Ws Selection Change Event Code, Copy a Cell problem

[Neal Zimm]

Hi All,
I'm just getting my ankles in the water re: ws selection
change event code.

The sub below is doing what I want, re: selection.
The users are NOT Excel wizards, hence maybe going over-
board in trying to control the cursor.

PROBLEM:
Testing the sheet, when I right click a 'good' cell
after selecting it to copy it to another cell,
I lose the wavy lines when this code ends,
and cannot use paste to complete the copy.

I don't want to force the user to type all of
the data. This sheet is a 'main' adjusting
sheet in my app. All the macros sit in an addin.

I don't know what I'm leaving out. I don't know
how to bring forward into the change event code
a 'right-clicked range' to be copied.

There is a Ws change event macro, not shown here.
If I must, I could move this logic to it. Ugh.

Thanks,
Neal Z.


Sub SVC_SelChg(ByVal CellAdr As String)
' CellAdr is target.address
' Edit all SubViewChg Ws selections. Keep protection on.

Const Title = "Subscriber Data View/Change"

Dim RngType As String
Dim Status As String

Dim Row As Long, Ix As Integer
Dim BlankRowAy() As Long
Dim ChgRow As Long, ChgCol As Integer
Dim HIrow As Long, HIcol As Integer
Dim ActRow As Long, ActCol As Integer
Dim PaBegRow As Long '1st row holding Pa account
Dim PaEndRow As Long 'last poss row for pa sel/chg
Dim LastExistACNrow As Long
Dim ACNcanBeAddRow As Long 'row of 'accounts can be added' literal
Dim LastAbrRow As Long 'last row with pa abr, above final 2 blank rows
Dim LastAdrRow As Long 'last row top half, N&Adr sub data
Dim COfs As Integer 'Ws column offset to SVrAy columns.
Dim Qty As Integer

Dim ExistACNrng As Range 'data can't be changed here
Dim DrawRng As Range 'mod subscr & temp stops cols, not these.
Dim ISect As Range 'intersect, test bad selections from above
Dim LastAddRng As Range 'final two rows PaAbr thru subscr.


'mainline start

EventsOFF ' disables events

COfs = gSVCwsColOfs ' Col offset lines up Ws with array receiving data later


' BREAKDOWN CELLADR (target.address) INTO ROWS COLS

Call RowsCols_vCellAdr(CellAdr, RngType, ChgRow, ChgCol, _
HIrow, HIcol, ActRow, ActCol)


' ID KEY Ws LOGIC ROWS
PaBegRow = gSVCpaBegRow 'row after col hdr's g = public constant
LastExistACNrow = Range("c1").Value
PaEndRow = Range(SIdCpaEndRow).Value ' usually e1
LastAdrRow = PaBegRow - 2 'row above col hdr's
LastAbrRow = PaEndRow - 2
ACNcanBeAddRow = Range("d1").Value - 1


Set ExistACNrng = Range(Cells(PaBegRow, SVrPaAbrCol + COfs), _
Cells(Range("c1").Value, SVrACNcol + COfs))


Set DrawRng = Range(Cells(PaBegRow, SVrDrawCol + COfs), _
Cells(PaEndRow, SVrDrawCol + COfs))


Set LastAddRng = Range(Cells(PaEndRow - 1, SVrPaAbrCol + COfs), _
Cells(PaEndRow, SVrSubscrCol + COfs))


If InStr(CellAdr, Comma) > 0 Then ' non contiguous ranges, no no

MsgBox "Invalid, using Ctrl Key to select non-contiguous cells, " _
& Cr2 & "is Not Allowed on this sheet.", vbCritical, Title

GoTo Quit
End If



' last row limitation
If ChgRow > PaEndRow Then
MsgBox "Row " & PaEndRow & " is last valid row to select.", _
vbExclamation, Title
Cells(PaEndRow, SVrPaAbrCol + COfs).Select
GoTo Quit
End If


' right most col limitation
If ChgCol > SVrSubNaCol + COfs Then
MsgBox "Column " & ColLtrs_FmNumF(SVrSubNaCol + COfs) _
& " is rightmost valid column to select.", _
vbExclamation, Title
Cells(ChgRow, SVrSubNaCol + COfs).Select
GoTo Quit
End If


' build array for blank 'visual spacer row' NON-selection
ReDim BlankRowAy(20)
For Row = PaBegRow + 1 To LastAbrRow - 1

If Cells(Row, SVrPaAbrCol + COfs) = "" Or Row = ACNcanBeAddRow Then

Qty = Qty + 1
If Qty > UBound(BlankRowAy) Then ReDim Preserve BlankRowAy(Qty)
BlankRowAy(Qty) = Row
End If
Next Row

For Ix = 1 To Qty
If ChgRow = BlankRowAy(Ix) Then
MsgBox "Invalid Row for Selection.", vbExclamation, Title

If ChgRow < ACNcanBeAddRow Then ChgRow = ChgRow - 1 Else _
If ChgRow = ACNcanBeAddRow Then ChgRow = ChgRow + 1 Else _
ChgRow = ChgRow - 1

Cells(ChgRow, SVrSubscrCol + COfs).Select

GoTo Quit
End If
Next Ix



' can't change draw directly
Set ISect = Application.Intersect(DrawRng, Selection)
If Not ISect Is Nothing Then

DrawRng.Select

MsgBox "Please change subscription or temp stops, NOT the draw.", _
vbExclamation, Title

Range(Cells(ChgRow, SVrSubscrCol + COfs), _
Cells(ChgRow, SVrOthTScol + COfs)).Select

GoTo Quit
End If


' can't change key existing account data
Set ISect = Application.Intersect(ExistACNrng, Selection)
If Not ISect Is Nothing Then

ExistACNrng.Select

MsgBox "Data here can't be changed. Change subscription or temp stops.", _
vbExclamation, Title

LastAddRng.Select

MsgBox "OR ... ADD accounts in above cells," & Cr2 & "OR to add a " _
& "2nd or 3rd account, using these cells.", vbExclamation, Title

Cells(ChgRow, SVrSubscrCol + COfs).Select

GoTo Quit
End If


If ChgCol = iColA Then 'column A is no-man's land.

Application.MoveAfterReturnDirection = xlToRight

If PaBegRow <= ChgRow And ChgRow <= LastExistACNrow Then

Cells(ChgRow, SVrSubscrCol + COfs).Select

ElseIf ChgRow = ACNcanBeAddRow Then

Cells(ChgRow + 1, SVrSubscrCol + COfs).Select

ElseIf ChgRow = ACNcanBeAddRow Then

Cells(ChgRow + 1, SVrSubscrCol + COfs).Select

ElseIf ACNcanBeAddRow < ChgRow And ChgRow <= LastAbrRow Then

Cells(ChgRow, SVrDlvCol + COfs).Select

ElseIf LastAbrRow < ChgRow And ChgRow <= PaEndRow Then

Cells(ChgRow, SVrPaAbrCol + COfs).Select
End If

ElseIf ChgCol < (SVrSubNaCol + COfs) Then

Application.MoveAfterReturnDirection = xlToRight

ElseIf ChgCol = (SVrSubNaCol + COfs) Then 'rightmost allowable

Application.MoveAfterReturnDirection = xlToLeft

End If


If ChgRow <> HIrow And ChgCol <> (SVrSubNaCol + COfs) Then

MsgBox "Please select in only 1 row.", vbExclamation, Title

Cells(ChgRow, ChgCol).Select
End If


Quit:
Call SVC_Protect ' protects this sheet, enables events
'mainline end
End Sub

 

[Dave Peterson]

Without looking at the code -- I stopped reading after the description that
you're losing the "marching ants" around the copied range.

One of the "features" of macros, including events, is that they can destroy the
cutcopymode. The only way I know to avoid this problem is to avoid macros that
do clear the cutcopymode. (Some minor macros don't do any harm.)

Maybe you could add code to your macro that asks the users for the range to be
copied and the range where it should be pasted.

 

[Neal Zimm]

Hi again Dave -
Actually, kinda glad to hear your answer, it's what I had guessed after
stepping thru the code a couple of times before I submitted this posting to
the community; as I could 'see' nothing wrong going on.

Can I assume that moving the selection event logic to the change event
macro would still give the same result ?

If it does, there's no real harm in having the user key the data.
The ws in question, is the result of a query the user makes, and user is
entering
data to change an account. Mostly single digits, it would be overkill to
ask again what cells does user want to copy. Was jes tryin' to be thorough
in my testing.

Thanks again,
Neal

 

[Dave Peterson]

I'm guessing that it won't make a difference (that you'll still have the
problem). But the only way to tell for sure is to test it.

====
I still haven't looked at the code, but maybe you could tell the user to select
the range first, then just ask where to paste?

dim RngToCopy as range
dim destcell as range
set rngtocopy = selection

....

Then determine the destination cell
set destcell = nothing
on error resume next
set destcell = application.inputbox(prompt:="select a cell", type:=8).cells(1)
on error goto 0
if destcell is nothing then
'user hit cancel
exit sub '??
end if

then you could do the copy (and all your checking)...

rngtocopy.copy _
destination:=destcell

(just an idea--it may not be close to what you want to do.)