Microsoft Office Forums - View Single Post - Automate fit worksheet width to fit screen

Logit · 07-13-2022, 11:47 AM

The following works with the ZOOM setting. Run the macro once it attempts to magnify ... run it again to reset :

Code:

Sub ZoomUR()
Dim Tmp As String
    If ActiveWindow.Zoom <> 100 Then
        ActiveWindow.Zoom = 100
    Else
        Tmp = ActiveCell.Address
        ActiveSheet.UsedRange.Select
        ActiveWindow.Zoom = True
        Range(Tmp).Select
    End If
End Sub

This next macro merely hides the empty columns set within a range :

Code:

'If the entire Column is empty :
Sub HideCol()
    Dim N As Long, wf As WorksheetFunction, M As Long
    Dim i As Long, j As Long

    N = Columns.Count
    M = Rows.Count
    Set wf = Application.WorksheetFunction
    Application.ScreenUpdating = False

    For i = 26 To 1 Step -1 '<<<---------------------------- Change 26 (Col Z) to reflect max columns possible
        If wf.CountBlank(Columns(i)) <> M Then Exit For
    Next i

    For j = i To 1 Step -1
        If wf.CountBlank(Columns(j)) = M Then
            Cells(1, j).EntireColumn.Hidden = True
        End If
    Next j

    Application.ScreenUpdating = True
End Sub