Não saco muito mas parece que pode ser o "Hidden" a cada k. Deixo pra galera.

Abs,

Boa tarde guma,

Não sei porque está lerdo, mas vê se ajuda:

Option Explicit

Sub Dropdown493_Alteração()
Dim LC  As Long
Dim k   As Long
Dim Ws  As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlManual

Columns("A:HL").EntireColumn.Hidden = False
LC = Cells(4, Columns.Count).End(xlToLeft).Column
Set Ws = Worksheets("Plan1")

    For k = 4 To LC
        If Ws.Cells(4, k) <> Ws.Range("B3") Then
            Columns(k).EntireColumn.Hidden = True
        End If
    Next k

Set Ws = Nothing

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Qualquer coisa da o grito.
Abraço

Boa noite!!

Eu fiz um teste com 5000 linhas e mais de 30 colunas, eu não tive problema!!

Repare que fiz uma micro mudança na rotina!

Sub Teste_AleVBA()
Dim LC As Long, k As Long

Application.ScreenUpdating = False
'Columns("A:HL").EntireColumn.Hidden = False

LC = Cells(4, Columns.Count).End(xlToLeft).Column

For k = 4 To LC
    If Cells(4, k) <> Range("B3") Then
        Columns(k).EntireColumn.Hidden = True
    End If
Next k

Application.ScreenUpdating = True
End Sub

Att