A worksheet is unexpectedly activated

[mumps]

I have a macro assigned to a button that runs perfectly on the data in the active sheet and in other sheets as well using Excel 2010. However, when I try to run it using Excel 2013 or Excel 2016, a different sheet is unexpectedly activated so the macro generates an error. There is nothing in the code that activates this other sheet and, to be safe, the macro disables events, even though there is nothing in the event code that even references to this other sheet. I have tried assigning the active sheet name to a variable at the beginning of the macro and the using that variable to activate the sheet even though it is already the active sheet, but the other sheet is still activated. I was wondering if anyone else has experienced this problem. I was hoping to get some feedback on what could possibly cause this to happen. As I already mentioned, it runs without errors using Excel 2010. My suspicion is that there is a glitch in the 2013 and 2016 versions of Excel. I haven't posted the code because it is quite long and part of a large project that calculates the final results of a cross country meet. If anyone has any suggestions or would like the code to be posted, I can certainly do that. Many thanks in advance.

Also posted at: A worksheet is unexpectedly activated

 

[RoryA]

Why does having a different sheet activated cause an error in your code?

 

[mumps]

The macro looks for blank cells in the active sheet and the data in the same cells in the other sheet aren't blank.

 

[RoryA]

I’d have to see the code I think. I assume you’ve tried stepping through to see where it happens?

 

[mumps]

Thank you, Rory. This is the code. I should also mention that there is also another macro which generates errors because it also unexpectedly activates a different sheet. No errors using Excel 2010. I expected 2013 and 2016 to be backward compatible.

Sub RaceResults()
    With Application
        .ScreenUpdating = False
        .Cursor = xlWait
        .EnableEvents = False
    End With
    Sheets("FinalStandings").Unprotect Password:="iwbi48crci"
    Sheets("RegionQualifiers").Unprotect Password:="iwbi48crci"
    ActiveSheet.Unprotect Password:="iwbi48crci"
    Dim bottomC As Long
    'Deletes blank rows.
    With Range("A3:E123")
        .AutoFilter 1, ""
        .AutoFilter 2, ""
        .AutoFilter 3, ""
    End With
    With ActiveSheet
        .AutoFilter.Range.Offset(3).EntireRow.Delete
        .Range("A3").AutoFilter
    End With
    'Inserts "?" if student name is missing.
    Dim bottomE As Long
    bottomE = Range("e" & Rows.Count).End(xlUp).Row
    On Error Resume Next
    Range("A4:A" & bottomE).SpecialCells(xlCellTypeBlanks) = "?"
    On Error GoTo 0
    'Looks for incorrect or missing school codes and asks for correction.
    Dim x As Long
    For x = 4 To bottomE
        If Range("B" & x) = "" Or Range("C" & x) = "" Then
            Cells(x, "A").Activate
            Application.Goto ActiveCell.EntireRow, True
            Do
                schcode = InputBox("The school code for the runner in Position " & Range("D" & x) & " is either missing or incorrect. Enter the correct school code.", "Correct School Code")
                If schcode <> "" Then
                    If Range("B" & x) = "" Or Range("C" & x) = "" Then Range("B" & x) = schcode
                    Exit Do
                ElseIf schcode = "" Then
                    MsgBox ("You must enter a valid school code in cell B" & x & " for the runner in Position " & Range("D" & x)) & "."
                    Else: Exit Do
                End If
            Loop
        End If
    Next x
    'Sorts according to School.
    Cells(3, 1).Sort Key1:=Columns(3), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
    'Numbers runners.
    Range("f3") = 1
    With Range("F4")
        .FormulaR1C1 = "=IF(((AND((RC[-5]=""""),(RC[-4]=""""),(RC[-3]="""")))),"""",IF((AND(RC[-5]<>"""",RC[-4]=R[-1]C[-4])),R[-1]C+1,IF(RC[-5]="""",R[-1]C,1)))"
        .AutoFill Destination:=Range("F4:F123"), Type:=xlFillDefault
    End With
    'Filters top 3 runners in each school.
    Range("A3:F3").AutoFilter Field:=6, Criteria1:="<4"
    bottomE = Range("E" & Rows.Count).End(xlUp).Row
    'Subtotals top 3 runners.
    Range("A3" & ":E" & bottomE + 1).Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(5), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    Range("F4").FillDown
    bottomE = Range("E" & Rows.Count).End(xlUp).Row
    'Deletes Grand Total line.
    Rows(bottomE).Delete
    If Range("F5") = "" Then Range("F5").FormulaR1C1 = _
        "=IF(((AND((RC[-5]=""""),(RC[-4]=""""),(RC[-3]="""")))),"""",IF((AND(RC[-5]<>"""",RC[-4]=R[-1]C[-4])),R[-1]C+1,IF(RC[-5]="""",R[-1]C,1)))"
    Range("F5:F" & bottomE).FillDown
    'Selects Teams with at least 3 runners and puts them in order of finish
    Dim r As Long, bottomF As Long, bottomH As Long, bottomJ As Long, FirstCell As Range, LastCell As Range
    bottomF = Range("F" & Rows.Count).End(xlUp).Row
    bottomH = Range("H" & Rows.Count).End(xlUp).Row
    bottomJ = Range("J" & Rows.Count).End(xlUp).Row
    'Formats headers for Team data range.
    Columns("H:H").ColumnWidth = 8
    Columns("I:I").ColumnWidth = 40
    Columns("K:K").ColumnWidth = 12
    Range("H3").Value = "Order"
    Range("I3").Value = "School"
    Range("K3").Value = "Team Points"
    With Range("H3:K3")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Interior.ColorIndex = 44
        .Borders(xlEdgeBottom).LineStyle = xlDouble
    End With
    With Range("H4:H185,J4:J185")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
     End With
    'Copies Teams to Team data range.
    Dim dic As Object, school As Range, srcRng As Range
    Set dic = CreateObject("Scripting.Dictionary")
    Set srcRng = Range("C4:C" & bottomF).SpecialCells(xlCellTypeVisible)
    For Each school In srcRng
        If school Like "*Total" And school.Offset(, 2) > 0 And school.Offset(, 3) > 2 Then
            x = school.Offset(, 2).Value
            dic.Add school, x
        End If
    Next school
    Dim shName As Range, col As String
    With Sheets("FinalStandings")
        Set shName = .Rows(1).Find(ActiveSheet.Name, LookIn:=xlValues, lookat:=xlWhole)
        col = Replace(Cells(1, shName.Column).Address(False, False), "1", "")
        .Range(col & 2, .Range(col & .Rows.Count).End(xlUp)).Value = .Range(col & 2, .Range(col & .Rows.Count).End(xlUp)).Value
    End With
    Range("A3").AutoFilter
    Range("I4").Resize(dic.Count).Value = Application.Transpose(dic.keys)
    Range("K4").Resize(dic.Count).Value = Application.Transpose(dic.items)
    Columns("J").Delete Shift:=xlToLeft
    With Range("H:H,K:K")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    'Removes the word "Total" from school name.
    Range("I4", Range("I" & Rows.Count).End(xlUp)).Replace "Total", "", xlPart
    'Aligns Column I to left.
    With Range("I:I")
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
    End With
    'Formats cell K3 - "Position First Runner".
    With Range("K3")
        .Value = "Position First Runner"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Interior.ColorIndex = 44
        .Borders(xlEdgeBottom).LineStyle = xlDouble
    End With
    'Breaks ties among teams.
    Cells(4, 10).Sort Key1:=Columns(10), Order1:=xlDescending, Orientation:=xlTopToBottom, Header:=xlYes
    'Numbers team order.
    With Range("H4")
        .Value = "1"
        .AutoFill Destination:=Range("H4").Resize(Range("I" & Rows.Count).End(xlUp).Row - 3), Type:=xlFillSeries
    End With
    'Enters Position of team runners.
    Dim team As Range, fnd As Range
    For Each team In Range("I4", Range("I" & Rows.Count).End(xlUp))
        Set fnd = Range("C:C").Find(Trim(team), LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            team.Offset(, 2) = fnd.Offset(, 1)
        End If
    Next team
    'Deletes formulae and leaves values by Column in FinalStandings sheet
    Dim Column As String, bottomColumn As Long
    With ActiveSheet
        If .Name = "13 Yr Boys" Then Column = "C"
        If .Name = "12 Yr Boys" Then Column = "D"
        If .Name = "11 Yr Boys" Then Column = "E"
        If .Name = "10 Yr Boys" Then Column = "F"
        If .Name = "9 Yr Boys" Then Column = "G"
        If .Name = "8 Yr Boys" Then Column = "H"
        If .Name = "13 Yr Girls" Then Column = "I"
        If .Name = "12 Yr Girls" Then Column = "J"
        If .Name = "11 Yr Girls" Then Column = "K"
        If .Name = "10 Yr Girls" Then Column = "L"
        If .Name = "9 Yr Girls" Then Column = "M"
        If .Name = "8 Yr Girls" Then Column = "N"
    End With
    bottomColumn = Sheets("FinalStandings").Range(Column & Rows.Count).End(xlUp).Row
    Sheets("FinalStandings").Range(Column & 2, Column & bottomColumn).Value = Sheets("FinalStandings").Range(Column & 2, Column & bottomColumn).Value
    Columns("F:F").Delete
    With Range("F3")
        .Interior.ColorIndex = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
    End With
    Cells(1, 6).ColumnWidth = 2
    Cells(1, 8).ColumnWidth = 30
    'Aligns Column I to center.
    With Range("I:I")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    Dim bottomD As Long
    bottomD = Range("d" & Rows.Count).End(xlUp).Row
    bottomE = Range("e" & Rows.Count).End(xlUp).Row
    Range("A3:E" & bottomE).Select
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("D4:D" & bottomD), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A3:E" & bottomE)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'Copies top 22 runners into RegionQualifiers
    Range("A4:C25").Copy
    Sheets("RegionQualifiers").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
    'Finds team runners outside of top 22 runners.
    bottomC = Range("C" & Rows.Count).End(xlUp).Row
    bottomH = Range("H" & Rows.Count).End(xlUp).Row
    Dim FirstTeam As String, SecondTeam As String
    FirstTeam = Trim(Range("H4"))
    SecondTeam = Trim(Range("H5"))
    Dim Counter As Long: Counter = 0
    For r = 4 To bottomC
        Set FirstCell = Range("A" & r)
        Set LastCell = Range("D" & r)
        If Range("A" & r).Offset(0, 2) = FirstTeam Then Counter = Counter + 1
        If Range("A" & r).Offset(0, 2) = FirstTeam And LastCell > 22 And Counter <= 3 _
        Then Range(FirstCell, LastCell.Offset(0, -1)).Copy _
        Destination:=Sheets("RegionQualifiers").Range("A1").End(xlDown).Offset(1, 0)
    Next r
    Counter = 0
    For r = 4 To bottomC
        Set FirstCell = Range("A" & r)
        Set LastCell = Range("D" & r)
        If Range("A" & r).Offset(0, 2) = SecondTeam Then Counter = Counter + 1
        If Range("A" & r).Offset(0, 2) = SecondTeam And LastCell > 22 And Counter <= 3 _
        Then Range(FirstCell, LastCell.Offset(0, -1)).Copy _
        Destination:=Sheets("RegionQualifiers").Range("A1").End(xlDown).Offset(1, 0)
    Next r
    'Copies Race Name into column D in RegionQualifiers.
    Dim myDest As Range
    Sheets("RegionQualifiers").Range("D" & Rows.Count).End(xlUp)(2).Value = Range("A2").Value
    With Sheets("RegionQualifiers")
        Set myDest = .Range("A" & Rows.Count).End(xlUp).Offset(, 3)
        With .Range("D" & Rows.Count).End(xlUp)
            .AutoFill Sheets("RegionQualifiers").Range(.Cells, myDest), xlFillCopy
        End With
    End With
    bottomJ = Range("J" & Rows.Count).End(xlUp).Row
    bottomI = Range("I" & Rows.Count).End(xlUp).Row
    Range("H4:J" & bottomJ).Select
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("I4:I" & bottomI), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("J4:J" & bottomJ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("H3:J" & bottomJ)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With ActiveSheet
        .Shapes.Range(Array("Rounded Rectangle 4")).Visible = False
        .Shapes.Range(Array("Rounded Rectangle 1")).Visible = False
        .Shapes.Range(Array("Rounded Rectangle 3")).Visible = True
        .Cells.Locked = True
    End With
    bottomB = Range("B" & Rows.Count).End(xlUp).Row + 1
    Rows(bottomB & ":" & bottomC).Delete
    Sheets("FinalStandings").Protect Password:="iwbi48crci"
    Sheets("RegionQualifiers").Protect Password:="iwbi48crci"
    ActiveSheet.Protect Password:="iwbi48crci"
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .Cursor = xlDefault
        .EnableEvents = True
    End With
    Range("A1").Select
End Sub

 

[RoryA]

A few questions:

which sheet is the button on?
is it activex or a form button?
which sheet gets activated?

 

[mumps]

The button is a shape (Rounded rectangle). It is on 12 different sheets. The macro I posted activates the sheet "FinalStandings".

 

[mumps]

I should add that I have another macro which activates the sheet "RegionQualifiers".

 

[RoryA]

Looks like a bug to me. If you unprotect more than one sheet, it activates the first one that isn't the active sheet. I'd suggest you set a worksheet variable to the activesheet at the start of the code, then use that instead of activesheet in the rest of it. That's better practice anyway since activesheet is late bound.

 

[Alex Blakenburg]

I can see no line in the code that does this:

The macro I posted activates the sheet "FinalStandings".