AutoFit Macro to Reduce row height?

Hello! I found this macro by Jim Rech, but it only increases row
height, not decreases.

The user inputs data into B1 to B20, and then the inputs are used in
the printed section of the spreadsheet (Rows 21-40, etc.)

So the formula for A21 for instance would say:

=IF(B1="","",B1)&IF(B2="","",B2)&IF(B3="","",B3).

So the cell B21 could contain as much as 3 lines of input or nothing
at all if the user leaves B1-B3 blank.

So the row 21 height of needs to grow or shrink depending on the
results of the formula.

Same for Row 22-40, etc.

a) Is there someway to alter this code so that it (for each sheet),
looks at the results of the formulas (values) within a range of cells
(some which have text wrap and merge on) , and then shrinks/grows
those row heights?

Thanks for the help!

VR/Lost



=============>>
Public Sub AutoFitMergedCellRowHeight()
'----------------------------------------------
'\\ Jim RECH http://tinyurl.com/esbrx
'\\ This macro does an autofit of row heights on merged cells:

'\\ Simulates row height autofit for a merged cell if the active
cell..
'\\ - is merged.
'\\ - has Wrap Text set.
'\\ - includes only 1 row.
'\\ Unlike real autosizing the macro only increases row height
'\\ (if needed). It does not reduce row height because another
'\\ merged cell on the same row may needed a greater height
'\\ than the active cell.
'----------------------------------------------

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
..MergeCells = False
..Cells(1).ColumnWidth = MergedCellRgWidth
..EntireRow.AutoFit
PossNewRowHeight = .RowHeight
..Cells(1).ColumnWidth = ActiveCellWidth
..MergeCells = True
..RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub