Code to Auto-Format Row Height of Merged Cells ALMOST Working

Fsfertick

New Member
Joined
May 5, 2018
Messages
1
Hi! Thank you so much to everyone on all of these forums! I've amazed myself with what I've been able to do with the help of Google and all the great people that reply to these posts. I'm almost complete with a project that I'm working and stuck on one thing. I have some merged cells with wrapped text and found that the row height wasn't expanding with my text. I found some code that pretty much solved my problem; however, it's not quite perfect as it's adding space for an additional row when it isn't necessary. For example, in one of my merged cells, the text could all fit on one row with about 40 characters to spare before it is necessary to add another row in, but it's still adding the extra row space, making the report look unprofessional. I'm looking at the code that I found, but don't see anywhere that I can experiment with tweaking it to perfect it. I'm hoping that someone out there can help. I'm a first-time poster and hopefully I don't mess up how I'm supposed to post the code. Any suggestions for modifications so that I get rid of the extra, unnecessary blank lines, are greatly appreciated!

Code:
Private Sub Worksheet_Change(ByVal Target As Range)


Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
Dim ProtectStatus As Boolean
With Target
If .MergeCells And .WrapText Then
ProtectStatus = Me.ProtectContents
If ProtectStatus Then Me.Unprotect ""
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
On Error Resume Next
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
On Error GoTo 0
Application.ScreenUpdating = True
If ProtectStatus Then Me.Protect ""
End If
End With
End Sub
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Forum statistics

Threads
1,224,830
Messages
6,181,228
Members
453,025
Latest member
Hannah_Pham93

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top