Bolds the top row, scrolls to the top left corner of the sheet, and autofits columns (with a maximum width so some text columns don’t get ridiculous)

PHOTO EMBED

Wed Sep 08 2021 06:00:25 GMT+0000 (UTC)

Saved by @Darkleech #vba

' Also bolds the top row, scrolls to the top left corner of the sheet, and autofits columns (with a maximum width so some text columns don’t get ridiculous).
' Active sheet: Prep for quick viewing
' Scroll to top-left corner, freeze top row, bold top row, AutoFit columns
Sub SetUp_NiceView()
    
    ' Declare variables
    Dim rowLast         As Long
    Dim colLast         As Integer
    Dim i               As Integer
    
    ' Maximum column width when AutoFitting columns
    ' Value needs to be in points (you can see the points when clicking-and-dragging to resize a column)
    Const maxColWidth   As Double = 35.86 ' 256 pixels
    
    ' Set up nice view!
    With ActiveSheet
        ' Unhide all cells
         On Error Resume Next
        .ShowAllData
        .Cells.EntireRow.Hidden = False
        .Cells.EntireColumn.Hidden = False
        On Error GoTo 0
        
        ' Get last row and column
        ' Excel's Find function remembers the last settings used: Search rows second so the Find function remembers to search by row
        On Error Resume Next
        colLast = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        rowLast = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        On Error GoTo 0
        
        ' If you don't want the code to unhide all cells, use these definitions instead:
        ' colLast = .UsedRange.Columns.Count
        ' rowLast = .UsedRange.Rows.Count
        
        If rowLast = 0 Or colLast = 0 Then Exit Sub
        
        ' Bold top row
        .Range(.Cells(1, 1), .Cells(1, colLast)).Font.Bold = True
        
        ' Freeze top row
        ActiveWindow.FreezePanes = False
        Application.GoTo .Cells(2, 1), True
        ActiveWindow.ScrollRow = 1
        ActiveWindow.FreezePanes = True
        .Cells(1, 1).Select
        
        ' Disable AutoFilter if it's on
        .AutoFilterMode = False
        
        ' AutoFilter top row
        With .Range(.Cells(1, 1), .Cells(rowLast, colLast))
            .AutoFilter
            
            ' AutoFit columns
            .Columns.AutoFit
            
            ' Loop through each column
            ' If any have exceed the max width, try AutoFitting just the header
            ' If the column still exceeds the max width, set it to the max width
            For i = 1 To colLast
                If .Columns(i).ColumnWidth > maxColWidth Then
                    .Columns(i).Cells(1).Columns.AutoFit
                    
                    If .Columns(i).ColumnWidth > maxColWidth Then
                        .Columns(i).ColumnWidth = maxColWidth
                    End If
                End If
            Next i
        End With
    End With
    
End Sub
content_copyCOPY