VBA Autofit merged cell

[SuzanneR8]

Hi,

I am relatively new to VBA and I have found a Macro which autofits merged cells to ensure they are all visible (by adjusting the row height).
the only issue is, the VBA I have leaves a huge gap above the text that is autofitted.

I can't seem to identify the issue. Any assistance, or any new macro would be greatly appreciated.

Macro is:

Option Explicit
Public Sub AutoFitAll()
Call AutoFitMergedCells(Range("c13:i13"))
Call AutoFitMergedCells(Range("c18:i18"))
End Sub
Public Sub AutoFitMergedCells(oRange As Range)
Dim tHeight As Integer
Dim iPtr As Integer
Dim oldWidth As Single
Dim oldZZWidth As Single
Dim newWidth As Single
Dim newHeight As Single
With Sheets("Business Pack")
oldWidth = 0
For iPtr = 0.5 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)
oldZZWidth = .Range("ZZ1").ColumnWidth
.Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
.Range("ZZ1").WrapText = True
.Columns("ZZ").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("ZZ1").ClearContents
.Range("ZZ1").ColumnWidth = oldZZWidth
End With
End Sub



Thank you!
Suzanne

 

[wideboydixon]

Re: VBA Autofit merged cell HELP NEEDED PLEASE!!

I suggest you take out this line:

oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth

Having calculated the width of all columns in the range, this line discards the calculation and uses the width of just two columns. Delete the line.

WBD