Can not replicate the issue,
If the cell value possibly have Error then change to
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myAreas As Areas, myArea As Range, i As Long, ws As Worksheet, myAdj As Long
Set myAreas = Union(Range("a4:a53,c4:c53,e4:e53,g4:g53"), Range("i4:i54,k4:k53,m4:m53"), _
Range("o4:o53,q4:q53,s4:s53"), Range("u4:u53,w3:w53,y3:y53,AA3:AA53")).Areas
Application.ScreenUpdating = False '<--- 1
myProtect False, Sheet5, Sheet7, Sheet8, Sheet9
For Each myArea In myAreas
For i = 1 To myArea.Count
If Not IsError(myArea(i).Value) Then
Select Case myArea(i).Column
Case Is <= 7
myAdj = 0
Set ws = Sheet5
Case Is <= 13
myAdj = -4
Set ws = Sheet7
Case Is <= 19
myAdj = -7
Set ws = Sheet8
Case Else
myAdj = -10
Set ws = Sheet9
End Select
ws.Columns((myArea(i).Column \ 2 + myAdj) * 58 + 9).Offset(, myArea(i).Row - 4).Hidden = myArea(i).Value = 0
End If
Next
Next
myProtect True, Sheet5, Sheet7, Sheet8, Sheet9
Application.ScreenUpdating = True '<---- 2
End Sub
Private Sub myProtect(flg As Boolean, ParamArray x())
Dim ws As Variant
For Each ws In x
If flg Then
ws.Protect "", Contents:=True, DrawingObjects:=False, UserInterfaceOnly:=True, AllowFormattingCells:=True
Else
ws.Unprotect ""
End If
Next
End Sub
Bookmarks