Difficult to run

Question

I have this code to hide and unhide the months this code is slow, how to improve it?

Sub jan1()

    Range("D2:ABG2").Copy
    Range("D1").PasteSpecial Paste:=xlPasteValues

    Range("D1:ABG1").Value = Range("D1:ABG1").Value

    Range("D1:ABG1").Select

    With Selection.Font

        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0

        Application.CutCopyMode = False

        Dim cell As Range

        For Each cell In ActiveWorkbook.ActiveSheet.Rows("1").Cells
            If cell.Value = "1" Then
                cell.EntireColumn.Hidden = True
            End If
        Next cell

        Range("C1").Select

    End With

End Sub

Answer 1

Use Intersect to obtain the used range in the first row, eliminating the need for the script to check each cell in row 1.

Sub jan1()
    Dim oSht1 As Worksheet
    Application.ScreenUpdating = True
    Set oSht1 = Sheets("Sheet1")  ' modify sheet name as needed
    oSht1.Cells.EntireColumn.Hidden = False
    ' copy value to the 1st row
    oSht1.Range("D1:ABG1").Value = oSht1.Range("D2:ABG2").Value
    With oSht1.Range("D1:ABG1").Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Dim cell As Range, rng As Range, rHide As Range
    ' get the used range in the 1st row (shrink target range to improve the efficiency)
    Set rng = Application.Intersect(oSht1.Rows(1), oSht1.UsedRange)
    Const START_COL = 4 ' only hidden columns after Col D 
    For Each cell In rng.Cells
        If cell.Column >= START_COL Then
            If cell.Value = "1" Then
                ' get the first cell of hidden columns
                If rHide Is Nothing Then
                    Set rHide = cell
                Else
                    Set rHide = Application.Union(rHide, cell)
                End If
            End If
        End If
    Next cell
    If Not rHide Is Nothing Then rHide.EntireColumn.Hidden = True
    Application.ScreenUpdating = False
End Sub

Microsoft documentation:

Application.Intersect method (Excel)

Application.Union method (Excel)