Shrink to fit Macro Button

I gather there is not a shrink to fit customize icon available in excel 2002.
So I would like to have one made. Could someone walk me through the steps
needed to establish one for relative cells.
--

Thanks in advance,

Ed

Assuming you mean 'AutoFit'...

1) Save the macro [AutoFitCols] listed below to your Personal.xls.
2) Right click on one of the menus at the top. A list of all the available
menus will appear. Select 'Customize...' at the bottom of the list.
3) select the 'Commands' tab
4) Scroll down the 'Categories' listbox to 'Macros'
5) In the 'Commands' listbox, drag the happy face to a menu at the top of
Excel
6) Right click on the happy face
7) From the list that appears, select 'Assign Macro...'
8) In the 'Macro Name:' text box, type:
Personal.xls!AutoFitCols
8) Select 'OK'
9) Select 'Close'

'--------Macro Begins-------------
''/=================================================/
' Sub Purpose:
' Fit selected columns to appropriate size
'
'Public Sub AutoFitCols()
Dim rngOriginalRng As Range, _
rng2BFormatted As Range

On Error GoTo err_Sub

Set rngOriginalRng = Selection

'verify that worksheet isn't blank,
' otherwise exit sub
If ActiveSheet.UsedRange.Columns.Count = _
0 Then GoTo exit_Sub

'create range of columns/header to be formatted
'STARTING AT 1st selected column
Set rng2BFormatted = _
Range(ActiveCell.Address).Resize(, _
Selection.Columns.Count)

With rng2BFormatted
.RowHeight = 150
.ColumnWidth = 3
.EntireColumn.AutoFit
.EntireRow.AutoFit
End With

exit_Sub:
On Error Resume Next
rngOriginalRng.Select
Set rng2BFormatted = Nothing
Set rngOriginalRng = Nothing
Exit Sub

err_Sub:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Sub: AutoFitCols - " & Now()
Resume exit_Sub
End Sub
''/=================================================/
'--------Macro Ends---------------

HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''Yes'' button next to ''Was this
Post Helpfull to you?''.


"inthestands" wrote:

> I gather there is not a shrink to fit customize icon available in excel 2002.
> So I would like to have one made. Could someone walk me through the steps
> needed to establish one for relative cells.
> --
>
> Thanks in advance,
>
> Ed--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''Yes'' button next to ''Was this
Post Helpfull to you?''.


"inthestands" wrote:

> I gather there is not a shrink to fit customize icon available in excel 2002.
> So I would like to have one made. Could someone walk me through the steps
> needed to establish one for relative cells.
> --
>
> Thanks in advance,
>
> Ed

Actually Gary I need to shrink to fit. I create many excel spreadsheets that
have long text strings in a cell that take up alot of room. So I often
shrink them to a smaller size. I am trying to avoid going through all of the
steps to shrink the data.
What I would like to do is select the range that I would like to shrink, be
it a column or selected cells, click an icon, and the data would shrink to
fit the cell(s) that I have selected. Thanks again
--
Ed


"Gary L Brown" wrote:

> Assuming you mean 'AutoFit'...
>
> 1) Save the macro [AutoFitCols] listed below to your Personal.xls.
> 2) Right click on one of the menus at the top. A list of all the available
> menus will appear. Select 'Customize...' at the bottom of the list.
> 3) select the 'Commands' tab
> 4) Scroll down the 'Categories' listbox to 'Macros'
> 5) In the 'Commands' listbox, drag the happy face to a menu at the top of
> Excel
> 6) Right click on the happy face
> 7) From the list that appears, select 'Assign Macro...'
> 8) In the 'Macro Name:' text box, type:
> Personal.xls!AutoFitCols
> 8) Select 'OK'
> 9) Select 'Close'
>
> '--------Macro Begins-------------
> ''/=================================================/
> ' Sub Purpose:
> ' Fit selected columns to appropriate size
> '
> 'Public Sub AutoFitCols()
> Dim rngOriginalRng As Range, _
> rng2BFormatted As Range
>
> On Error GoTo err_Sub
>
> Set rngOriginalRng = Selection
>
> 'verify that worksheet isn't blank,
> ' otherwise exit sub
> If ActiveSheet.UsedRange.Columns.Count = _
> 0 Then GoTo exit_Sub
>
> 'create range of columns/header to be formatted
> 'STARTING AT 1st selected column
> Set rng2BFormatted = _
> Range(ActiveCell.Address).Resize(, _
> Selection.Columns.Count)
>
> With rng2BFormatted
> .RowHeight = 150
> .ColumnWidth = 3
> .EntireColumn.AutoFit
> .EntireRow.AutoFit
> End With
>
> exit_Sub:
> On Error Resume Next
> rngOriginalRng.Select
> Set rng2BFormatted = Nothing
> Set rngOriginalRng = Nothing
> Exit Sub
>
> err_Sub:
> Debug.Print "Error: " & Err.Number & " - (" & _
> Err.Description & _
> ") - Sub: AutoFitCols - " & Now()
> Resume exit_Sub
> End Sub
> ''/=================================================/
> '--------Macro Ends---------------
>
> HTH,
> --
> Gary Brown
> gary_brown@ge_NOSPAM.com
> If this post was helpful, please click the ''Yes'' button next to ''Was this
> Post Helpfull to you?''.
>
>
> "inthestands" wrote:
>
> > I gather there is not a shrink to fit customize icon available in excel 2002.
> > So I would like to have one made. Could someone walk me through the steps
> > needed to establish one for relative cells.
> > --
> >
> > Thanks in advance,
> >
> > Ed--
> Gary Brown
> gary_brown@ge_NOSPAM.com
> If this post was helpful, please click the ''Yes'' button next to ''Was this
> Post Helpfull to you?''.
>
>
> "inthestands" wrote:
>
> > I gather there is not a shrink to fit customize icon available in excel 2002.
> > So I would like to have one made. Could someone walk me through the steps
> > needed to establish one for relative cells.
> > --
> >
> > Thanks in advance,
> >
> > Ed

Boy, did I overkill.
Use the same steps but use the following Macro instead.
'--------Macro Begins-------------
'/=================================================/
' Sub Purpose:
' Fit selected columns to appropriate size
'
Public Sub AutoFitCols()

'verify that you have selected a range
' otherwise exit sub
If Selection.Count = _
0 Then GoTo exit_Sub

'shrink the selected area
Selection.ShrinkToFit = True

End Sub
'/=================================================/
'--------Macro Ends---------------
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''Yes'' button next to ''Was this
Post Helpfull to you?''.


"inthestands" wrote:

> Actually Gary I need to shrink to fit. I create many excel spreadsheets that
> have long text strings in a cell that take up alot of room. So I often
> shrink them to a smaller size. I am trying to avoid going through all of the
> steps to shrink the data.
> What I would like to do is select the range that I would like to shrink, be
> it a column or selected cells, click an icon, and the data would shrink to
> fit the cell(s) that I have selected. Thanks again
> --
> Ed
>
>
> "Gary L Brown" wrote:
>
> > Assuming you mean 'AutoFit'...
> >
> > 1) Save the macro [AutoFitCols] listed below to your Personal.xls.
> > 2) Right click on one of the menus at the top. A list of all the available
> > menus will appear. Select 'Customize...' at the bottom of the list.
> > 3) select the 'Commands' tab
> > 4) Scroll down the 'Categories' listbox to 'Macros'
> > 5) In the 'Commands' listbox, drag the happy face to a menu at the top of
> > Excel
> > 6) Right click on the happy face
> > 7) From the list that appears, select 'Assign Macro...'
> > 8) In the 'Macro Name:' text box, type:
> > Personal.xls!AutoFitCols
> > 8) Select 'OK'
> > 9) Select 'Close'
> >
> > '--------Macro Begins-------------
> > ''/=================================================/
> > ' Sub Purpose:
> > ' Fit selected columns to appropriate size
> > '
> > 'Public Sub AutoFitCols()
> > Dim rngOriginalRng As Range, _
> > rng2BFormatted As Range
> >
> > On Error GoTo err_Sub
> >
> > Set rngOriginalRng = Selection
> >
> > 'verify that worksheet isn't blank,
> > ' otherwise exit sub
> > If ActiveSheet.UsedRange.Columns.Count = _
> > 0 Then GoTo exit_Sub
> >
> > 'create range of columns/header to be formatted
> > 'STARTING AT 1st selected column
> > Set rng2BFormatted = _
> > Range(ActiveCell.Address).Resize(, _
> > Selection.Columns.Count)
> >
> > With rng2BFormatted
> > .RowHeight = 150
> > .ColumnWidth = 3
> > .EntireColumn.AutoFit
> > .EntireRow.AutoFit
> > End With
> >
> > exit_Sub:
> > On Error Resume Next
> > rngOriginalRng.Select
> > Set rng2BFormatted = Nothing
> > Set rngOriginalRng = Nothing
> > Exit Sub
> >
> > err_Sub:
> > Debug.Print "Error: " & Err.Number & " - (" & _
> > Err.Description & _
> > ") - Sub: AutoFitCols - " & Now()
> > Resume exit_Sub
> > End Sub
> > ''/=================================================/
> > '--------Macro Ends---------------
> >
> > HTH,
> > --
> > Gary Brown
> > gary_brown@ge_NOSPAM.com
> > If this post was helpful, please click the ''Yes'' button next to ''Was this
> > Post Helpfull to you?''.
> >
> >
> > "inthestands" wrote:
> >
> > > I gather there is not a shrink to fit customize icon available in excel 2002.
> > > So I would like to have one made. Could someone walk me through the steps
> > > needed to establish one for relative cells.
> > > --
> > >
> > > Thanks in advance,
> > >
> > > Ed--
> > Gary Brown
> > gary_brown@ge_NOSPAM.com
> > If this post was helpful, please click the ''Yes'' button next to ''Was this
> > Post Helpfull to you?''.
> >
> >
> > "inthestands" wrote:
> >
> > > I gather there is not a shrink to fit customize icon available in excel 2002.
> > > So I would like to have one made. Could someone walk me through the steps
> > > needed to establish one for relative cells.
> > > --
> > >
> > > Thanks in advance,
> > >
> > > Ed