VBA to resize merged cells textboxes

[tomsilvester]

Please help me with this, I've been looking for a good solution to this for ages!

I'm trying to create a macro which runs and resizes merged cell text boxes to fit the text within them.

I found this code online on a different forum, which was working (albeit very slowly) a few days ago however it has now stopped working!

Option Explicit
Option Base 1
Sub FixMerged2()
Dim mw As Single
Dim cM As Range
Dim rng As Range
Dim cw As Double
Dim rwht As Double
Dim ar As Variant
Dim i As Integer
Application.ScreenUpdating = False
'Cell Ranges below, change to suit.
ar = Array("text1", "text2", "text3")
For i = 1 To UBound(ar)
On Error Resume Next
Set rng = Range(Range(ar(i)).MergeArea.Address)
With rng
.MergeCells = False
cw = .Cells(1).ColumnWidth
mw = 0
For Each cM In rng
cM.WrapText = True
mw = cM.ColumnWidth + mw
Next
mw = mw + rng.Cells.Count * 0.66
.Cells(1).ColumnWidth = mw
.EntireRow.AutoFit
rwht = .RowHeight
.Cells(1).ColumnWidth = cw
.MergeCells = True
.RowHeight = rwht
End With
Next i
Application.ScreenUpdating = True
End Sub

If anyone is aware of a solution to this problem I would be infinitely grateful! I'm not set on using the code above; I'll use whatever technique works best.

Thanks in advance for your assistance.

Tom

 

[nuked]

What do you mean when you say it no longer works? Does it do anything at all? Have you checked that you still have named-ranges called "text1", "text2", and "text3"?

 

[tomsilvester]

All the cell named-ranges remain unchanged. No error message is flagged, it just doesn't do anything! I click on the shape the macro is assigned to and it shows a loading symbol for about 2 seconds then just stops.

Sorry that the details are sparse but that's all I have.

 

[nuked]

Have you tried running it directly from the VB Editor, rather than through a 'shape'?