Auto fit Row Heights In Merged Cells

Hi,

I have this code to fit row heights in merged cells. This works ok but it takes a few minutes to run. I also have the problem of when I insert a new row or delete a row these cell references are then no longer correct. Can anyone adjust this formula to speed it up and use maybe a named range to reference these cells so they adjust when rows are inserted and deleted before the code is run?

Sub Fit_Row_Heights()
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
ar = Array("C14", "C61", "C108", "C155", "C202", "C249", "C296", "C343", "C390", "C437", "C484", "C531", "C578", "C625", "C672", "C719", "C766", "C813", "C860", "C907", "C954", "C1001", "C1048", _
"C1095", "C1142", "C1189", "C1236", "C1283", "C1330", "C1377", "C1424", "C1471", "C1518", "C1565", "C1612", "C1659", "C1706", "C1753", "C1800", "C1847", "C1894", "C1941", "C1988", "C2035", "C2082", "C2129", _
"C2176", "C2223", "C2270", "C2317", "C2364", "C2411", "C2458", "C2505", "C2552", "C2599", "C2646", "C2693", "C2740", "C2787", "C2834", "C2881", "C2928", "C2975", "C3022", "C3069", "C3116", "C3163", "C3210", _
"C3257", "C3304", "C3351", "C3398", "C3445", "C3492", "C3539", "C3586", "C3633", "C3680", "C3727", "C3774", "C3821", "C3868", "C3915", "C3962", "C4009", "C4056", "C4103", "C4150", "C4197", "C4244", "C4291", _
"C4338", "C4385", "C4432", "C4479", "C4526", "C4573", "C4620", "C4667", "C4714", "C4761", "C4808", "C4855", "C4902", "C4949", "C4996", "C5043", "C5090", "C5137", "C5184", "C5231", "C5278", "C5325", "C5372", _
"C5419", "C5466", "C5513", "C5560", "C5607", "C5654", "C5701", "C5748", "C5795", "C5842", "C5889", "C5936", "C5983", "C6030", "C6077", "C6124", "C6171", "C6218", "C6265", "C6312", "C6359", "C6406", "C6453", _
"C6500", "C6547", "C6594", "C6641", "C6688", "C6735", "C6782", "C6829", "C6876", "C6923", "C6970", "C7017", "C7064", "C7111", "C7158", "C7205", "C7252", "C7299", "C7346", "C7393", "C7440", "C7487", "C7534", _
"C7581", "C7628", "C7675", "C7722", "C7769", "C7816", "C7863", "C7910", "C7957", "C8004", "C8051", "C8098", "C8145", "C8192", "C8239", "C8286", "C8333", "C8380", "C8427", "C8474", "C8521", "C8568", "C8615", _
"C8662", "C8709", "C8756", "C8803", "C8850", "C8897", "C8944", "C8991", "C9038", "C9085", "C9132", "C9179", "C9226", "C9273", "C9320")
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

Thanks in advance for any help with this!