Sheets names flashing up in duplicate when running vba

[Kerryx]

When running my VBA code the sheet names flash up in duplicate at the bottom of the screen, any thoughts why.

Sub Optimise(Flag As Boolean)
On Error Resume Next
F = Not Flag
Application.ScreenUpdating = F
Application.DisplayAlerts = F
Application.EnableEvents = F
Application.DisplayStatusBar = F
ActiveSheet.DisplayPageBreaks = F
If F = True Then
Application.Calculation = xlCalculationAutomatic
Else
Application.Calculation = xlCalculationManual
End If
On Error GoTo 0
End Sub

Sub Update()

'switch off updating to stop screen flickering

Optimise (True)

SheetList = Array("Leaderboard", "Entries_by_Name", "Points_by_League", "Tables", "Admin")


For Count = 0 To UBound(SheetList)

'Unprotect the sheets
Sheets(SheetList(Count)).Unprotect

'Add date and time to admin sheet
Sheets("Admin").Range("A2").Value = Now

Next


' Update - Refresh Queries
'
ActiveWorkbook.RefreshAll
DoEvents


' Sort the sheet

With ActiveWorkbook.Worksheets("Leaderboard").Sort
.SortFields.Clear
.SortFields.Add Range("P1"), , xlAscending 'Sort by Sort Help Help column P
.SortFields.Add Range("R1"), , xlDescending ' Sort by GD value
.SortFields.Add Range("D1"), , xlDescending 'Sort Total column

.SetRange Range("B1:R350")
.Header = xlYes

.Apply
End With
Sheets("Leaderboard").Select
Range("A1").Select

'Allow screen to update now

Optimise (False)

'Reprotect the modified sheets

For Count = 0 To UBound(SheetList)
'DoEvents
Do
    DoEvents
    Application.Calculate
Loop While Not CalculationState = xlDone

Sheets(SheetList(Count)).Protect

Next
'MsgBox "Job Done"

End Sub

 

[pitchoute]

Sub Optimise(Flag As Boolean)
    On Error Resume Next
    F = Not Flag
    Application.ScreenUpdating = F
    Application.DisplayAlerts = F
    Application.EnableEvents = F
    Application.DisplayStatusBar = F
    ActiveSheet.DisplayPageBreaks = F
    If F = True Then
        Application.Calculation = xlCalculationAutomatic
    Else
        Application.Calculation = xlCalculationManual
    End If
    On Error GoTo 0
End Sub

Sub Update()

    Optimise True

    SheetList = Array("Leaderboard", "Entries_by_Name", "Points_by_League", "Tables", "Admin")

    For Count = 0 To UBound(SheetList)
        ' Unprotect the sheets
        Sheets(SheetList(Count)).Unprotect
    Next Count

    Sheets("Admin").Range("A2").Value = Now

    ActiveWorkbook.RefreshAll
    DoEvents 

    With ActiveWorkbook.Worksheets("Leaderboard").Sort
        .SortFields.Clear
        .SortFields.Add Range("P1"), , xlAscending ' Sort by Sort Help column P
        .SortFields.Add Range("R1"), , xlDescending ' Sort by GD value
        .SortFields.Add Range("D1"), , xlDescending ' Sort Total column
        .SetRange Range("B1:R350")
        .Header = xlYes
        .Apply
    End With

    Sheets("Leaderboard").Select
    Range("A1").Select

    Optimise False

    For Count = 0 To UBound(SheetList)
        Sheets(SheetList(Count)).Protect
    Next Count

End Sub

 

[Kerryx]

ok blocked out the lines referencing the DoEvents and reran the code still flashing up the sheet names in duplicate at bottom of excel workbook

For Count = 0 To UBound(SheetList)
'DoEvents
''Do
''    DoEvents
''    Application.Calculate
''Loop While Not CalculationState = xlDone

Sheets(SheetList(Count)).Protect
Next Count

 

[Alex Blakenburg]

I believe the key change that @pitchoute made that impacted the error is to take the updating of the Admin sheet out of the unprotect loop.
It is trying to update the Admin sheet before it has been unprotected.

The doubling up looks to be related to the DisplayStatusBar being turned off. If you comment out the DisplayStatusBar line, it doesn't happen.
When the code errors out it seems to try to move the Tab display line back to its original place of being the 2nd last line of the Excel application screen but doesn't have the displaystatusbar turned on to take up the last line.

For Count = 0 To UBound(SheetList)

'Unprotect the sheets
Sheets(SheetList(Count)).Unprotect

'Add date and time to admin sheet
Sheets("Admin").Range("A2").Value = Now

Next

Sheets("Admin").Range("A2").Value = Now

 

[Kerryx]

Ok tried that updated as mentioned no doubling just the blurring of tabs trying to move horizontally

 

[Alex Blakenburg]

What changes did you make ?
Did you move the Admin sheet update to below the Next of the Unprotect loop ?
Did you comment out the Application.DisplayStatusBar = F ?

Now before you run the code in the immediate window paste the below and hit enter.

Application.DisplayStatusBar = True

(This is to reset it to True since it might still be False after your code crashing)

 

[Kerryx]

Yes did all those , updated code below that i have now

Sub Optimise(Flag As Boolean)
On Error Resume Next
F = Not Flag
Application.ScreenUpdating = F
Application.DisplayAlerts = F
Application.EnableEvents = F
'Application.DisplayStatusBar = F
ActiveSheet.DisplayPageBreaks = F
If F = True Then
Application.Calculation = xlCalculationAutomatic
Else
Application.Calculation = xlCalculationManual
End If
On Error GoTo 0
End Sub

Sub Update()

'switch off updating to stop screen flickering

Optimise (True)

SheetList = Array("Leaderboard", "Entries_by_Name", "Points_by_League", "Tables", "Admin")

  For Count = 0 To UBound(SheetList)
        ' Unprotect the sheets
        Sheets(SheetList(Count)).Unprotect

    Next Count

    Sheets("Admin").Range("A2").Value = Now

' Update Macro - Download football league tables and game results from the website
'
ActiveWorkbook.RefreshAll
DoEvents


'
' Sort Macro

With ActiveWorkbook.Worksheets("Leaderboard").Sort
.SortFields.Clear
.SortFields.Add Range("P1"), , xlAscending 'Sort by Sort Help Help column P
.SortFields.Add Range("R1"), , xlDescending ' Sort by GD value
.SortFields.Add Range("D1"), , xlDescending 'Sort Total column

.SetRange Range("B1:R350")
.Header = xlYes

.Apply
End With
Sheets("Leaderboard").Select
Range("A1").Select

'allow screen to update now

Optimise (False)

'reprotect the modified sheets

For Count = 0 To UBound(SheetList)

Sheets(SheetList(Count)).Protect

Next Count

'MsgBox "Job Done"

End Sub

added your code to immediate window pressed eneter ran code and tab jumping horizontally still there

 

[Alex Blakenburg]

While I could replicate your issue initially I can't replicate it using the updated code you posted.
Other than closing Excel and reopening it and/or restarting the machine, I don't have any more ideas.

PS: I don't have anything in my workbook to refresh so I don't know if that comes into play.
If you want to share your workbook via google drive or a sharing platform I am happy to take a look but I am signing off for the night now.

 

[Kerryx]

ok thanks Alex

 

[Alex Blakenburg]

I can see the issue but I don't understand why on your set up ScreenUpdating and DisplayAlerts just don't seem to be changing to False.
I don't have that issue when I create a new workbook.
I am loging off for the night will have another look tomorrow if noone else comes up with anything in the meantime.