AutoFit Merged Cells

[Lindsay0385]

Hello -

I'm aware that AutoFit doesn't work with merged cells and it is best not to work with merged cells, if at all possible. However, I've done a lot of googling to find workarounds for my spreadsheet. The solution I really like uses Worksheet_Change, but I already have a Worksheet_Change in the code on my sheet that I really need, so that won't work. So I did more searching and found a code that partially works on this forum.

My spreadsheet has merged cells in Row 12 from C12:K12. The code I found is below (edited slightly) and I have a macro button to run it. It almost works as expected. Problem is, when I enter 1 word and run the macro, the row height becomes 23.25 high. I enter 2 words it becomes 30. 4 words becomes 45. One full line of text becomes 165 and so on. All of those situations would fit in a row 15 high. It's like it's exponentially growing. My columns C:K are differently sized, I don't know if that would make a difference. I don't know what's wrong with it.

Any help is appreciated!

Thanks,
Lindsay

Public Sub AutoFitMergedCells()
 
  Dim oRange As Range
  Dim tHeight As Integer
  Dim iPtr As Integer
  Dim oldWidth As Single
  Dim oldAAWidth As Single
  Dim newWidth As Single
  Dim newHeight As Single
  
  Set oRange = Range("C12:K12")
  oldWidth = 0
  For iPtr = 1 To oRange.Columns.Count
    oldWidth = oldWidth + Cells(1, oRange.Column + iPtr - 1).ColumnWidth
  Next iPtr
  oldWidth = Cells(1, oRange.Column).ColumnWidth + Cells(1, oRange.Column + 1).ColumnWidth
  oRange.MergeCells = False
  newWidth = Len(Cells(oRange.Row, oRange.Column).Value)
  oldAAWidth = Range("AA1").ColumnWidth
  Range("AA1") = Left(Cells(oRange.Row, oRange.Column).Value, newWidth)
  Range("AA1").WrapText = True
  Columns("AA").ColumnWidth = oldWidth
  Rows("1").EntireRow.AutoFit
  newHeight = Rows("1").RowHeight / oRange.Rows.Count
  Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
  oRange.MergeCells = True
  oRange.WrapText = True
  Range("AA1").ClearContents
  Range("AA1").ColumnWidth = oldAAWidth
  
End Sub

 

[Lindsay0385]

Well, I found my own solution. I guess I just need a good night sleep and a fresh look at the code. I made minor changes if anyone ever needs this.

 Option Explicit
 
Public Sub AutoFitMergedCells()
    Call GoFast(True)
  Dim oRange As Range
  Dim tHeight As Integer
  Dim iPtr As Integer
  Dim oldWidth As Single
  Dim oldAAWidth As Single
  Dim newWidth As Single
  Dim newHeight As Single
  
  Set oRange = Range("C12:K12")
  oldWidth = 0
  For iPtr = 1 To oRange.Columns.Count
    oldWidth = oldWidth + Cells(1, oRange.Column + iPtr - 2).ColumnWidth
  Next iPtr
  oRange.MergeCells = False
  newWidth = Len(Cells(oRange.Row, oRange.Column).Value)
  oldAAWidth = Range("AA1").ColumnWidth
  Range("AA1") = Left(Cells(oRange.Row, oRange.Column).Value, newWidth)
  Range("AA1").WrapText = True
  Columns("AA").ColumnWidth = oldWidth
  Rows("1").EntireRow.AutoFit
  newHeight = Rows("1").RowHeight / oRange.Rows.Count
  Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
  oRange.MergeCells = True
  oRange.WrapText = True
  Range("AA1").ClearContents
  Range("AA1").ColumnWidth = oldAAWidth
  
 Call GoFast(False)
End Sub