Do you ever have a worksheet with lots of columns of data, and you wish you
could autofit the row heights using only some of those columns? Me too.
Sometimes you have a cell that has a bunch of text in it, and it makes the
row height a lot bigger than you really want it to be when you use Excel's
Autofit. That's why I put together the routine below. Select the columns
you want to autofit, and run the macro. It works pretty well for me. Hope
you find it useful.

Eric

'
' Row_Autofit_Selected_Columns Macro
' Macro created 2/26/2010
' Sets row height of the active sheet by using autofit
' ONLY on the columns in the current selection.
' NOTE: Creates a temporary worksheet in the current workbook.
'
Sub Row_Autofit_Selected_Columns()
Dim i As Long
Dim nAreas As Long, nCols As Long, nRows As Long
Dim tArea As Range
Dim tStr As String
Dim oldWS As Worksheet, newWS As Worksheet
'
Application.ScreenUpdating = False
'
Set oldWS = ActiveSheet
'
' Create temporary worksheet
'
ActiveWorkbook.Worksheets.Add
Set newWS = ActiveSheet
oldWS.Activate
'
' Copy each column of data from the old workbook
' to the new workbook area (for multiple selections) one at a time.
'
nCols = 0
For Each tArea In Selection.Areas
tArea.Columns.Select
Selection.Copy
newWS.Activate
ActiveSheet.Cells(1, nCols + 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=True, _
Transpose:=False
nCols = nCols + tArea.Columns.Count
oldWS.Activate
Next tArea
'
' Autofit the rows on the temporary sheet, then copy that row height
' information back to the original sheet.
'
newWS.Activate
tStr = Application.ConvertFormula( _
Formula:="c1:c" & nCols, _
fromReferenceStyle:=xlR1C1, _
toReferenceStyle:=xlA1)
ActiveSheet.Columns(tStr).Select
Selection.Rows.AutoFit
'
nRows = ActiveSheet.UsedRange.Rows.Count
For i = nRows To 1 Step -1
oldWS.Rows(i).RowHeight = newWS.Rows(i).RowHeight
Next i
'
oldWS.Activate
Application.DisplayAlerts = False
newWS.Delete
Application.DisplayAlerts = True
'
Application.ScreenUpdating = True
'
Set newWS = Nothing
Set oldWS = Nothing
'
End Sub

Very good idea. Be sure to select the header row in your selections and
discontinuous ranges is a nice feature. Share more routines with us.

--
Data Hog


"EricG" wrote:

Do you ever have a worksheet with lots of columns of data, and you wish you
could autofit the row heights using only some of those columns? Me too.
Sometimes you have a cell that has a bunch of text in it, and it makes the
row height a lot bigger than you really want it to be when you use Excel's
Autofit. That's why I put together the routine below. Select the columns
you want to autofit, and run the macro. It works pretty well for me. Hope
you find it useful.

Eric

'
' Row_Autofit_Selected_Columns Macro
' Macro created 2/26/2010
' Sets row height of the active sheet by using autofit
' ONLY on the columns in the current selection.
' NOTE: Creates a temporary worksheet in the current workbook.
'
Sub Row_Autofit_Selected_Columns()
Dim i As Long
Dim nAreas As Long, nCols As Long, nRows As Long
Dim tArea As Range
Dim tStr As String
Dim oldWS As Worksheet, newWS As Worksheet
'
Application.ScreenUpdating = False
'
Set oldWS = ActiveSheet
'
' Create temporary worksheet
'
ActiveWorkbook.Worksheets.Add
Set newWS = ActiveSheet
oldWS.Activate
'
' Copy each column of data from the old workbook
' to the new workbook area (for multiple selections) one at a time.
'
nCols = 0
For Each tArea In Selection.Areas
tArea.Columns.Select
Selection.Copy
newWS.Activate
ActiveSheet.Cells(1, nCols + 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=True, _
Transpose:=False
nCols = nCols + tArea.Columns.Count
oldWS.Activate
Next tArea
'
' Autofit the rows on the temporary sheet, then copy that row height
' information back to the original sheet.
'
newWS.Activate
tStr = Application.ConvertFormula( _
Formula:="c1:c" & nCols, _
fromReferenceStyle:=xlR1C1, _
toReferenceStyle:=xlA1)
ActiveSheet.Columns(tStr).Select
Selection.Rows.AutoFit
'
nRows = ActiveSheet.UsedRange.Rows.Count
For i = nRows To 1 Step -1
oldWS.Rows(i).RowHeight = newWS.Rows(i).RowHeight
Next i
'
oldWS.Activate
Application.DisplayAlerts = False
newWS.Delete
Application.DisplayAlerts = True
'
Application.ScreenUpdating = True
'
Set newWS = Nothing
Set oldWS = Nothing
'
End Sub