Macro to autofit row height, and then reduce back to original height

Hi there,

I have a row of data that is particularly large and need to keep it at reasonable height so that other information can be seen in one glance. However, the data needs to be read so I need a macro that autofits the row height when clicked, and then reduces back to original height in the next click...

If anyone can help it would be so appreciated!

Thanks
Lesley

Below is VBA code that was tested in Excel 2003. A command button is clicked to expand row heights
for all rows where cells are selected, then click the button again and all data rows
row heights are returned to normal. A file is attached. I hope you can test this file in Excel 2000.

Private Sub CommandButton1_Click()
'Row heights can be increased with this macro if text is formatted as "Wrap Text".
'Click once: increases row height for all data rows where a cell is selected
'Click again: sets row heights of all data rows to the default row height

Dim rng As Range
Dim firstDataRow As Long
Dim mycell As Object
Const RHEIGHT = 12.75

    firstDataRow = 2
    
    If Mid(CommandButton1.Caption, 1, 6) = "Expand" Then
        'increase heights of rows where a cell is selected
        Set rng = Application.Selection
        
        If rng.Count = 1 And ActiveCell.Row < firstDataRow Then
            'no data rows were selected
            rng.Select
            Exit Sub
        End If
    
        For Each mycell In rng
            If mycell.Row >= firstDataRow Then
                Range(mycell.Address).EntireRow.AutoFit
            End If
        Next
        CommandButton1.Caption = "Normal Row Height"

    Else
        'set row heights for all data rows to normal
        Set rng = ActiveSheet.UsedRange
    
        For Each mycell In rng
            If mycell.Row >= firstDataRow And mycell.RowHeight <> RHEIGHT Then
                Range(mycell.Address).RowHeight = RHEIGHT
            End If
        Next
        CommandButton1.Caption = "Expand Selected Row(s) Height"
    End If

    Set rng = Nothing
    
End Sub