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

 

[Alex Blakenburg]

Try selecting the query "fxTeamID" changing the properties to turn off background refresh (you have already done this on the others)
Save the spreadsheet.
Then rerun the code and see if the issue is gone.

Note: to reproduce the issue, it only happens if Leaderboard is not the active sheet. Moving selecting of the Leaderboard sheet before the Refresh all line, also resolves the issue.

 

[Kerryx]

Alex tried both suggetions and unfortunatley issue still there.

 

[Alex Blakenburg]

I am running out of ideas but give this a try.

ActiveWindow.DisplayWorkbookTabs = False
DoEvents
ActiveWorkbook.RefreshAll
ActiveWindow.DisplayWorkbookTabs = True

 

[Kerryx]

I am running out of ideas but give this a try.

ActiveWindow.DisplayWorkbookTabs = False
DoEvents
ActiveWorkbook.RefreshAll
ActiveWindow.DisplayWorkbookTabs = True

Alex took your idea and tweaked it by adding it to the Optimise part of the code and it worked a dream thanks for your help.

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
[B]ActiveWindow.DisplayWorkbookTabs = F[/B]
If F = True Then
Application.Calculation = xlCalculationAutomatic
Else
Application.Calculation = xlCalculationManual
End If
On Error GoTo 0
End Sub

Optimise (True)

REST OF CODE

Optimise (False)

For Count = 0 To UBound(SheetList)
'DoEvents
Sheets(SheetList(Count)).Protect
Next Count
End Sub

 

[Alex Blakenburg]

Appreciate the feedback. Glad we could help.

 

[Wazzateo]

In VBA, the DoEvents command will cause the ScreenUpdating setting to automatically change from False to True. This causes the flickering.

Try this, the code below uses API to lock the updated application screen

#If VBA7 Then
Private Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwndLock As LongPtr) As Long
#Else
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
#End If

Sub Test()
    On Error Resume Next
    LockWindowUpdate Application.Hwnd
    ' Do something
    LockWindowUpdate 0&
End Sub

Before exiting the method, LockScreenUpdate 0& needs to be called

 

[Wazzateo]

The suggested code below helps you optimize your appliaction settings.

Sub Optimise_Test1()
      SpeedOn 
      ' Do something
      SpeedOff 
End Sub
Sub Optimise_Test2()
      Dim e1%, e2%, e3%
      SpeedOn e1, e2, e3
      ' Do something
      SpeedOff e1, e2, e3
End Sub

Sub Optimise_Test3()
      Dim e1%, e2%, e3%
      SpeedOn e1, e2, e3
      ' Do something
      SpeedOff e1, e2, e3
End Sub

Sub Optimise_Test4()
      Dim e1%, e2%, e3%
      SpeedOn e1, e2, e3
      Call Optimise_Test3
      SpeedOff e1, e2, e3
End Sub

Sub SpeedOn( _
             Optional screen% = 1, Optional Events% = 1, Optional Calcula% = -1, _
             Optional Display% = -1, Optional CalSave% = -1, Optional ByVal App As Object)
  AppFaster True, screen, Events, Calcula, Display, CalSave, App
End Sub
Sub SpeedOff(Optional screen% = 1, Optional Events% = 1, Optional Calcula% = -1, _
             Optional Display% = -1, Optional CalSave% = -1, Optional ByVal App As Object)
  AppFaster False, screen, Events, Calcula, Display, CalSave, App
End Sub
Private Sub AppFaster(Optional ByVal fast As Boolean = False, _
             Optional screen% = 1, Optional Events% = 1, Optional Calcula% = -1, _
             Optional Display% = -1, Optional CalSave% = -1, Optional ByVal App As Object)
  'Fast: 0 | 1
  'Slow: 0 | 1 | 2 | 3
  'Skip: #0 #1
  'On Error Resume Next
  If App Is Nothing Then Set App = Application
  Static e1%, e2%, e3%, e4%, e5%, dt As Date
  Dim v1%, v2%, v3&, k%, b%, ot As Boolean, y As Boolean
  ot = dt > 0 And ((dt + TimeSerial(0, 0, 15)) < Now)
  v1 = screen:  v2 = e1: GoSub sw:  screen = v1: e1 = v2
  v1 = Events:  v2 = e2: GoSub sw:  Events = v1: e2 = v2
  v1 = Calcula: v2 = e3: GoSub sw: Calcula = v1: e3 = v2
  v1 = Display: v2 = e4: GoSub sw: Display = v1: e4 = v2
  v1 = CalSave: v2 = e5: GoSub sw: CalSave = v1: e5 = v2
  Err.Clear
  
  If y Then dt = Now
Exit Sub
sw: k = k + 1: v3 = 0: b = 0: If ot Then v2 = 0
  If fast Then GoSub fast Else GoSub slow
Return
fast:
With App
  Select Case True
  Case v1 = 1 And v2 = 0: b = 1
  Case v1 = 0 And v2 = 0: b = 2
  Case v1 = 0 And v2 = 2: b = 3
  End Select
  
  If b Then
    Select Case k
    Case 1: v3 = .ScreenUpdating: If v3 Then .ScreenUpdating = False
    Case 2: v3 = .EnableEvents: If v3 Then .EnableEvents = False
    Case 3: Err.Clear: v3 = .Calculation <> -4135: If v3 And Err = 0 Then .Calculation = -4135
    Case 4: v3 = .DisplayAlerts: If v3 Then .DisplayAlerts = False
    Case 5: Err.Clear: v3 = .CalculateBeforeSave: If v3 And Err = 0 Then .CalculateBeforeSave = False
    Case 6: v3 = .Cursor <> xlWait: If v3 Then .Cursor = xlWait
    Case 7: v3 = .StatusBar: If v3 Then .StatusBar = False
    Case 8: v3 = .EnableCancelKey <> xlErrorHandler: If v3 Then .EnableCancelKey = xlErrorHandler
    End Select
    If v3 Then
      y = True
      Select Case b
      Case 1: v1 = 1: v2 = 0
      Case 2: v1 = 2: v2 = 1
      Case 3: v1 = 1: v2 = 1
      End Select
    End If
  End If
End With
Return
slow:
With App
  Select Case True
  Case v1 = 0 And v2 = 0: b = 1
  Case v1 = 1 And v2 = 0: b = 2
  Case v1 = 2 And v2 = 1: b = 3: v2 = 0
  Case v1 = 3:            b = 4: v2 = Switch(v2 = 0, 0, v2 = 1, 2, True, 2)
  End Select
  If b Then
    Select Case k
    Case 1: v3 = .ScreenUpdating: If v3 = 0 Then .ScreenUpdating = True
    Case 2: v3 = .EnableEvents: If v3 = 0 Then .EnableEvents = True
    Case 3: Err.Clear: v3 = .Calculation = -4105: If v3 = 0 And Err = 0 Then .Calculation = -4105
    Case 4: v3 = .DisplayAlerts: If v3 = 0 Then .DisplayAlerts = True
    Case 5: Err.Clear: v3 = .CalculateBeforeSave: If v3 = 0 And Err = 0 Then .CalculateBeforeSave = True
    Case 6: v3 = .Cursor <> xlDefault: If v3 Then .Cursor = xlDefault
    Case 7: v3 = .StatusBar: If v3 Then .StatusBar = False
    Case 8: v3 = .EnableCancelKey <> xlInterrupt: If v3 Then .EnableCancelKey = xlInterrupt
    End Select
  End If
End With
Return
End Sub