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

The sub below is doing what I want, 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