Adjust height of two merged cells

Question

My goal is that the height of a merged cell adjusts automatically to its content. This works fine for one cell with this piece of code:

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim h, rng As Range

    Set rng = Selection

    If ActiveCell.MergeCells Then
        With ActiveCell.MergeArea
            If .WrapText = True Then
                With rng
                    .UnMerge
                    .Cells(1).EntireRow.AutoFit
                    h = .Cells(1).RowHeight
                    .Merge
                    .EntireRow.AutoFit

                    With .Cells(1).MergeArea
                        .Cells(.Cells.Count).RowHeight = (h - .Height + 14.25)
                    End With
                End With
            End If
        End With
    End If
End Sub

However, if I have two cells in the same row and the second one is shorter it adjusts to the second one.. (see the example below)

Any ideas on how I can fix this so that it only adjusts, when there is no cell with more height in the same row?

Here is an updated version. Btw. the cells are all in the same column (AS and AU)

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)


 Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
 If ActiveCell.MergeCells Then


 Dim heigtAS, heightAU As Integer

  'AS-Block
 Dim hAS, rngAS As Range
    Set rngAS = Range("AS10:AS18")

    With rngAS.MergeArea
         If .WrapText = True Then
             With rngAS
            .UnMerge
            .Cells(1).EntireRow.AutoFit
             hAS = .Cells(1).RowHeight
            .Merge
            .EntireRow.AutoFit
            With .Cells(1).MergeArea
            heightAS = (hAS - .Height + 14.25)
            'save height of cell

            End With
            End With

         End If
     End With

 'AU-Block
 Dim hAU, rngAU As Range
 Set rngAU = Range("AU10:AU18")

    With rngAU.MergeArea
         If .WrapText = True Then
             With rngAU
            .UnMerge
            .Cells(1).EntireRow.AutoFit
             hAU = .Cells(1).RowHeight
            .Merge
            .EntireRow.AutoFit
            With .Cells(1).MergeArea
            heightAU = (hAU - .Height + 14.25)
            'save height of cell



            End With
            End With

         End If
     End With


 'Compare height and fit cell height
If heightAS > heightAU Then
    .Cells(.Cells.Count).RowHeight = heightAS
Else
    .Cells(.Cells.Count).RowHeight = heightAU
End If
End If


End Sub

I somehow can't make it work...

Answer 1

private void MergeAndFit(Range range)
    {
        range.MergeCells = false;
        double cellWidth = range.Columns[1].ColumnWidth;
        double mergeWidth = 0;
        foreach (Range cm in range)
        {
            cm.WrapText = true;
            mergeWidth += cm.ColumnWidth;
        }

        mergeWidth = mergeWidth + range.Cells.Count * 0.66;
        range.Columns[1].ColumnWidth = mergeWidth;
        range.EntireRow.AutoFit();
        double newRowHeight = range.RowHeight;
        range.Columns[1].ColumnWidth = cellWidth;
        range.MergeCells = true;
        range.RowHeight = newRowHeight;
    }

The function above takes an excel range object and merge cells. sets the row height to maximum to show all content.I'm not sure if this fits for you but can you convert this to vb.net and tell me if it works.