Autosizing multi-line merged cells in Excel using macros

As part of my previously mentioned Excel project i also had to display multi-line content in cells. Incidentally, most of this content was in the RTF fields mentioned in my previous post.

However, Excel has some issues with auto sizing merged cells containing such content. To be more specific - if the cell containing such text is merged, all Excel methods for auto sizing fail miserably.

So I went ahead and looked for this on the net. After quite a bit of searching I managed to find a forum thread dealing with this problem. Since my memory is worse than that of a fish, I'm afraid I can't give proper credit to the author of the code that solves the problem (just spent another half an hour searching for that thread, but can't find it :( ).

Anyway, the original solution was made so that a macro would first search for all merged cells and then auto-size their respective lines based on the content of those cells. Although this solution may fail if you have single cells that would resize higher than other cells, it was fine for me.

I have modified the original algorithm since I already knew which cells would require auto-sizing. So the "gathering" algorithm is in my case simplified to adding appropriate cell info into the array as I add new cells to the final report.
The actual resizing algorithm is unmodified.

This is what needs to be done:


  'add merged cells into an array
  If iFirst = 1 Then
    ReDim myTexts(0)
    iFirst = 0
  Else
    ReDim Preserve myTexts(UBound(myTexts) + 1)
  End If
  opisi(UBound(myTexts)) = "D" & iRow & ":G" & iRow
  'note that columns D to G were used in my .xls. You can use whatever range you want, just make sure you add all the cells

  'Actual resizing code
  If iFirst = 0 Then
    'Do this only if you added any elements into the array
    For i = LBound(opisi) To UBound(opisi)
      sReport.Range(opisi(i)).Select
      With ActiveCell.MergeArea
        If .Rows.Count = 1 And .WrapText = True Then
          'Do the magic
          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
      MergedCellRgWidth = 0
    Next i
  End If