Autofit row height by merged cells too big

[Daniëlle_001]

Hi everyone,

I was struggling a long time with the autofit row height by merged cells, and finally i have a macro that works. My only problem, the row height becomes far too big. How can i make the row height a good fit?

This is my code:

Option Explicit
Public Sub AutoFitAll()
Call AutoFitMergedCells(Range("b162:i162"))
Call AutoFitMergedCells(Range("b166:i166"))
Call AutoFitMergedCells(Range("b168:i168"))
Call AutoFitMergedCells(Range("b170:i170"))
Call AutoFitMergedCells(Range("b172:i172"))
Call AutoFitMergedCells(Range("b176:i176"))
Call AutoFitMergedCells(Range("b178:i178"))
Call AutoFitMergedCells(Range("b184:i184"))
Call AutoFitMergedCells(Range("b190:i190"))
Call AutoFitMergedCells(Range("b196:i196"))
Call AutoFitMergedCells(Range("b200:i200"))
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("Rapport")
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)
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

Thanks a lot!

 

[Dryver14]

.Rows("1").EntireRow.AutoFit
newHeight = .Rows("1").RowHeight / oRange.Rows.Count

With these 2 lines is row 1 ok? if so then remove the division at the end of new height statement.

 

[Daniëlle_001]

.Rows("1").EntireRow.AutoFit
newHeight = .Rows("1").RowHeight / oRange.Rows.Count

With these 2 lines is row 1 ok? if so then remove the division at the end of new height statement.

Unfortunately, it doesn't work. I added "Call AutoFitMergedCells(Range("a1:f1"))" at the beginning of the code, merged the cells a1 till f1 and add some text that's too big for the cellhigh. But, row 1 stays 1 row high. Too small for the text. It doesn't work at all by row 1.