Autofit Zoom View to active/visible cells in table? - excel

Question

I wasn't able to find any vba zoom except for auto-changing based on resolution, but is it possible to autofit custom zoom level based on most furthest out column that has text?
Sub Workbook_Open()
ActiveWindow.Zoom = 100 'also you can change to other size
End Sub
Bonus Code:
To reset the scroll bar to far left, so it's looking at Column A/Row1, this code works :) I have it on a "reset" userbutton.
'Scroll to a specific row and column
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Thank you in advance.

Answer 1

Try this code:
Function FindFurthestColumn(S As Worksheet) As Integer
Dim CellsWithContent As Long
CellsWithContent = WorksheetFunction.CountA(S.Cells)
If CellsWithContent = 0 Then
FindFurthestColumn = 1
Exit Function
End If
Dim CellsCount As Long
Dim j As Integer
Do
j = j + 1
CellsCount = CellsCount + WorksheetFunction.CountA(S.Columns(j))
Loop Until CellsCount = CellsWithContent
FindFurthestColumn = j
End Function
Function CellIsVisible(cell As Range) As Boolean
CellIsVisible = Not Intersect(ActiveWindow.VisibleRange, cell) Is Nothing
End Function
Sub ZoomVisibleCells()
Application.ScreenUpdating = False
Dim LastColumn As Integer
LastColumn = FindFurthestColumn(ActiveSheet)
Dim SplitCell As Range
If ActiveWindow.Split = True Then
Set SplitCell = Cells(ActiveWindow.SplitRow + 1, ActiveWindow.SplitColumn + 1)
ActiveWindow.FreezePanes = False
End If
Dim Zoom As Integer
For Zoom = 400 To 10 Step -1
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
ActiveWindow.Zoom = Zoom
If CellIsVisible(ActiveSheet.Cells(1, LastColumn + 1)) Then
Exit For
End If
Next Zoom
If Not SplitCell Is Nothing Then
SplitCell.Activate
ActiveWindow.FreezePanes = True
End If
Application.ScreenUpdating = True
End Sub
Credit for the CellIsVisible function:
https://stackoverflow.com/a/11943260/14370454

Answer 2

AUTO ZOOM RESPONSIVE VIEW EXCEL VBA CODE
In a sheet type any character on cell A1 and your last column view then type a character on first row with last column. That's it, see a magic of responsive view Excel sheet/s.
Note: copy this code and paste it to Thisworkbook module.
Thank you all.
Private Sub Workbook_WindowResize(ByVal Wn As Window)
Dim LastCol As Long
Dim rng As Range
Dim x As Integer
Dim y As Integer
With ActiveSheet
Set rng = .Rows(1).Find(What:="*", LookIn:=xlFormulas, SearchDirection:=xlPrevious)
End With
If Not rng Is Nothing Then
LastCol = rng.Column
Else
LastCol = 1
End If
x = 1 ' For First Column
y = LastCol ' For Last
Columns(Chr(64 + x) & ":" & Chr(64 + y)).Select
ActiveWindow.Zoom = True
ActiveSheet.Range("E1").Select
End Sub