Macro to adjust row height to show all text in merged cell

Hi All,

I require some help in writing a code in VBA that adjusts the row height to show all the text which is in the merged cells of different rows.

Some rows contains a merged cell that extends from column F to S, that has alignment formatting of Horizontal: Left Indent, Vertical: Top, Wrapped=True

These merged cells contain fairly lengthy text, so with the settings as above, i just need to adjust the row heights of each to show all the text. This becomes quite a task considering there are about 50 rows on 5 different sheets, so I want a macro to do it.

so far i have only been able to come up with a code that performs the task on one merged cell i.e. when its the active cell

Sub AutoFitRowHeightt()
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

what i need is for the macro to do is:

1)search through the range A3:A100 looking for any cells that contain text or just <>"".
2)for each cell that it finds, i want it to adjust the row height so that all the text in the cell is shown.

I am attempting to develop a work around and to date have the below:

Sub findString()
    Dim sFind  As String
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    sFind = Application.InputBox("A1:A250")
    If sFind <> "" Then
        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 If
End Sub

As may be apparent tomost of you, the above work around is incorrect. Any help modifying the first code in order to perform the two noted tasks would be greatly appreciated.

Best,

Joe