Excel 2013 VBA SelectionChange Event

Question

I am using Excel 2013 and have come across a problem with SelectionChange Event that is driving me nuts. I wonder if someone can help me on this. I have been at it for so long (over a week!) I may be missing something that is easily visible to someone out there. The below code works fine in Excel 2007 and 2010.

Initially when you Activate the page the code will instantly revert you to the calling page (in this insatnce Main Menu). The second time around the code works correctly. At some stage by simply selecting new cells it will revert you to another page. In my instance it takes me back to the Main Menu page.

There are three routines being called in my problem (1) Selection Change Event, (2) SetHighlightRows1(ByVal Target As Range), (3) MinRowsHeight_ActiveCell

Thanks for any assistance/sglxl

Option Explicit

Private Declare Function LockWindowUpdate Lib "USER32" _
                                          (ByVal hwndLock As Long) As Long
----------------------------------------------------------------------------------------------

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

    Dim Msg, Style, Title, Response

    ' Similar to ScreenUpdating but this locks the Shapes from continuous Flickering
    LockWindowUpdate Application.hWnd

    ' Initialise
    ActiveSheet.Unprotect Password:=pw
    Application.ScreenUpdating = False

    ' Highlight selected rows
    Call SetHighlightRows1(ActiveCell)

    ' Reset ScreenUpdating to False
    Application.ScreenUpdating = False

    ' Headings in all sheets set to Max 53
    ' Build Message
    Msg = "You cannot access this area!"
    Style = vbOKOnly + vbInformation
    Title = "Company Secretary"

    On Error Resume Next

    ' Limit access area so that row heights remain constant
    If Not (Intersect(Target, Range("A1:O8")) Is Nothing) Or Not (Intersect(Target, Range("A1011:O1011")) Is Nothing) Then
        Response = MsgBox(Msg, Style, Title)
        Range("ptrCursor").Select
        GoTo CleanUp:
    Else
        Target.Select
    End If

    ' Set Row Height
    ' EnableEvents set to TRUE
    Call MinRowsHeight_ActiveCell

    ' Unprotect AkSht as MinRowsHeight_ActiveCell set Protect = True
    ActiveSheet.Unprotect Password:=pw

    Rows(3).EntireRow.RowHeight = 53

CleanUp:

    ' CleanUp
    ActiveSheet.Protect Password:=pw, AllowFiltering:=True
    Application.ScreenUpdating = True

    ' Unlock the window updating in the end by passing a null to the LockWindowUpdate API function.
    LockWindowUpdate 0

End Sub

' ---------------------------------------------------------------------------------

'----------------------------------------------------------------
Public Sub SetHighlightRows1(ByVal Target As Range)
'----------------------------------------------------------------

    Dim MyRng As Range
    Dim TargetCol
    Dim TargetRow
    Dim BeginColumn As Long
    Dim EndColumn As Long
    Dim BeginRow As Long

    ' Initialise
    ' Disable Events before SelectionChange occurs. There may be other events that
    ' may Trigger the SelectionChange
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    On Error Resume Next

    ' Define Row and Column ranges to make routine dynamic
    TargetCol = Target.Column
    TargetRow = Target.Row
    BeginColumn = ActiveSheet.Range("ptrColumnBegin").Column
    EndColumn = ActiveSheet.Range("ptrColumnEnd").Column - 1
    BeginRow = ActiveSheet.Range("ptrBeginCell").Row

    ' ***** Set Range parameters *****
    Set MyRng = Range(Cells(TargetRow, BeginColumn), Cells(TargetRow, EndColumn))

    ' Initialise
    ' Disable Events before SelectionChange occurs. There may be other events that
    ' may Trigger the SelectionChange
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    On Error GoTo CleanUp

    If TargetCol > EndColumn Then GoTo CleanUp

    ' ***** Set range limits *****
    ' ActiveSheet.Range("ptrEndCell").Row - 1 - This will ensure that if the user inserts additionalRows
    ' The highlighter bar will follow to include the additional Rows
    If TargetRow < BeginRow Or TargetRow > ActiveSheet.Range("ptrEndCell").Row - 1 Then GoTo CleanUp
    ' ***** End Range Limits *****

    Application.Cells.FormatConditions.Delete

    ' Highlight Columns
    With MyRng
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
        With .FormatConditions(1).Font
            .Bold = True
            .Italic = False
            ' .Color = RGB(192, 0, 0) ' Seaxl Red
            .Color = RGB(83, 141, 213)    ' Dark Blue
            .Color = RGB(0, 51, 204)    ' Dark Blue
        End With
        '                .FormatConditions(1).Interior.Color = RGB(225, 234, 204)    ' Green
        '                .FormatConditions(1).Interior.Color = RGB(220, 230, 241)    ' Light Blue
        .FormatConditions(1).Interior.Color = RGB(248, 248, 248)    ' Light Grey
    End With

CleanUp:

    ' CleanUp
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

' ---------------------------------------------------------------------------------

Sub MinRowsHeight_ActiveCell()

    'Initialise
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:=pw
    Application.EnableEvents = False

    ' Only Visible Cells are set to min height
    ActiveSheet.Range("tblDatabaseSort").SpecialCells(xlCellTypeVisible).RowHeight = 22.5

    ' Adjust only the ActiveCell Row height to AutoFit
    ActiveCell.EntireRow.AutoFit
    If ActiveCell.EntireRow.RowHeight < 22.5 Then
        ActiveCell.EntireRow.RowHeight = 22.5
    End If

    ' CleanUp
    Application.ScreenUpdating = True
    ActiveSheet.Protect Password:=pw
    Application.EnableEvents = True

End Sub

Answer 1

I've been reviewing some of your code, my notes are below:

I set up your code on my excel 2013 and ran it. (I added the named ranges as required). I reviewed the code by commenting out all code lines with LockWindowUpdate and with Application.ScreenUpdating and with Application.EnableEvents. The code works ok. However, when I re-added them the code did not work as you intended.

When I enter Application.EnableEvents = true into the immediate window youre code starts working again.

I suggest you do the same and gradually re-add each of these and fine out what' happening. I suspect Application.EnableEvents is being turned off and left off. See poitn -1 below which shows where this might be happening... (What error might be causing it I don't know).

I think you need to improve your error handling so it reports more information.

Thanks for posting this I found you code very informative and interesting and learn a MAJOR TECHNIQUE, namely useing conditional formatting to apply format temporarily to cells. Nice.

---------------------------------------------------------------------

Here's what I noticed

---

-1. When MinRowsHeight_ActiveCell is called, if an error is raised (eg named range tblDatabaseSort does not exist, ETC!) it will raise an error and skip cleanup where Application.EnableEvents = True turns it on. Hence leaving it off!

---

1. Range("ptrCursor").Select Addressing ranges like this without activesheet.range( being used, might pick up the range on other sheets - in the event that it is not defined on the activesheet. It would raise an error in this case.

---

1. Add activesheet. in front of: Range( and Cells( This is implicitly the case at the moment.

   ' ***** Set Range parameters ***** Set MyRng = Range(Cells(TargetRow, BeginColumn), Cells(TargetRow, EndColumn))

---

2. If named ranges are not defined code continues...

   On Error Resume Next

   ' Define Row and Column ranges to make routine dynamic TargetCol = Target.Column TargetRow = Target.Row BeginColumn = ActiveSheet.Range("ptrColumnBegin").Column EndColumn = ActiveSheet.Range("ptrColumnEnd").Column - 1 BeginRow = ActiveSheet.Range("ptrBeginCell").Row

---

3. This code snippet is repeated unnecessarily in your code - I think

   ' Initialise ' Disable Events before SelectionChange occurs. There may be other events that ' may Trigger the SelectionChange Application.ScreenUpdating = False Application.EnableEvents = False

---

4. Application.Cells.FormatConditions.Delete

   ' Highlight Columns With MyRng .FormatConditions.Delete

I would have written ActiveSheet.Cells.FormatConditions.Delete, but your code does the same thing. The later code (above) deletes them again which is unnecessary.

(PS. If you used this on a sheet that has other format conditions, you would need to delete the format conditions more intelligently)