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

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

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

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