self-adjusting column widths (and sheet, kindof)

Posted by Kiran. K on October 05, 2001 2:28 AM

Hi,
I was wondering if anyone knows how to get EXcel
to create self-adjusting column widths. That is,
if I type text in a cell, and it exceeds the width,
the text "outside" the width of the cell gets hidden
when I'm done typing. If I have many cells whose
text columns are varying, I'd have to manually
adjust the width every single time.

So, is there a way where I can select a whole sheet
and say "adjust column width according to max width
of text typed in all cells" ?

Along the saame lines, if I have a sheet with more
columns than I can see on screen, is there a way to
have excel adjust the font size automatically to
adjust the display to fit the screen ?

Many thanks,

-Kiran.

Posted by Robb on October 05, 2001 4:15 AM

Kiran

If you paste this code in the ThisWorkbook code:

- Open VBE (Alt+F11 from workbook)
- Display Porject Explorer (if it isn't displayed) - available from View Menu (or Ctrl+R)
- Double click on ThisWorkbook
- Paste the code in the window that will be displayed

All columns in all worksheets should then autofit on each change.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
ActiveSheet.Columns(Target.Column).AutoFit

End Sub

I've never tried testing whether or not usedrange fits in the screen, so will elave that
for now.

Any help though?

Regards

Posted by Henry on October 05, 2001 6:45 AM

Re fitting the screen to show all columns, try the following (not fully tested - perhaps someone (Robb?) can touch it up) :-

Private Sub Workbook_SheetChange(ByVal Target As Range)
Dim vis As Range, firstRow As Long, lastRow As Long, lastCol As Integer
Dim screen As Range
Application.EnableEvents = False
ActiveWindow.Zoom = 100
Set vis = ActiveWindow.VisibleRange
firstRow = vis.Rows(1).Row
lastRow = vis.Rows(vis.Rows.Count).Row
lastCol = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
Set screen = Range(Cells(firstRow, 1), Cells(lastRow, lastCol))
Application.Goto screen, True
Application.ScreenUpdating = True
ActiveWindow.Zoom = True
Application.EnableEvents = True
End Sub

Posted by Robb on October 06, 2001 8:13 PM

Thanks Henry.

Kiran

I've amended Henry's code a little and incorporated it in the SheetChange event.

Paste this in place of the code I posted for columns autofit:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim uR As Range
Application.ScreenUpdating = False
ActiveSheet.Columns(Target.Column).AutoFit
ActiveWindow.Zoom = 100
Set uR = ActiveSheet.UsedRange
Application.Goto uR, True
ActiveWindow.Zoom = True
uR.Cells(1, 1).Select
If ActiveWindow.Zoom > 100 Then ActiveWindow.Zoom = 100
Application.ScreenUpdating = True
End Sub

Any help?

Regards

Re fitting the screen to show all columns, try the following (not fully tested - perhaps someone (Robb?) can touch it up) :- Private Sub Workbook_SheetChange(ByVal Target As Range)

Posted by Henry Root on October 06, 2001 10:22 PM

But .......

Robb

Your code fits the sheet's whole UsedRange to the window (doesn't it?). This is not so practical if there are a lot of rows.
I thought it was required to fit the used columns to the window - not the whole UsedRange of the sheet.

Henry I've amended Henry's code a little and incorporated it in the SheetChange event. Paste this in place of the code I posted for columns autofit:

Posted by Robb on October 08, 2001 3:47 AM

Wait - try this instead (Thanks Henry) Re: But .......

Henry

You are right - I reread the post and Kiran does indeed want the columns
to fit rather than the whole range. Thanks for picking that up.

Kiran

Try this instead (I hope you don't have too many columns):

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim uR As Range, vR As Range, fC As Integer, lC As Integer
Application.ScreenUpdating = False
ActiveSheet.Columns(Target.Column).AutoFit
ActiveWindow.Zoom = 100
With ActiveSheet
fC = .UsedRange.Columns(1).Column
lC = (.UsedRange.Columns.Count) + (fC - 1)
Set uR = .Range(.Columns(fC), .Columns(lC))
Application.Goto uR, True
ActiveWindow.Zoom = True
End With
Set vR = ActiveWindow.VisibleRange
vR.Cells(1, 1).Select
If ActiveWindow.Zoom > 100 Then ActiveWindow.Zoom = 100
Application.ScreenUpdating = True
End Sub

Hope it does what you wanted.

Regards

Robb