If the multi-area address is over 255, break it down into separate addresses
of less than 255, then Union, something like this -

set r = Range(s1)
set r = Union(r, Range(s2))
etc

I haven't really looked at the rest of what you are doing. Probably worth
experimenting to see if better to make the big multi area range, or loop
smaller ranges, eg

ReDim arrAddresses(1 to 5) '
arrAddresses(1) = "1st address-less-than-255"
etc

for i = 1 to ubound( arrAddresses)
set r = range(arrAddresses(i))
do-stuff with r
next

Regards,
Peter T


"CC-AAP" wrote in message
...
I am trying to enter code to auto-expand merged cells. I have multiple
ranges
within the same worksheet that will be affected by this macro. I believe
that
I have reached the maximum range length for the macro. I need to add more
cells. How would I go about adding them to this macro OR can I add a
second
macro for the additional cells?

Here is what I currently have:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim r As Range, c As Range, cc As Range
Dim ma As Range

Set r =
Range("A18:G18,A19:G19,A20:G20,A21:G21,A22:G22,A24 :D24,A25:D25,A26:D26,E24:H24,E25:H25,E26:H26,A30:G 30,A31:G31,A32:G32,A33:G33,A34:G34,A36:D36,A37:D37 ,A38:D38,E36:H36,E37:H37,E38:H38,D41:H41,D42:H42,D 43:H43,D45:H45,D47:H47,D48:H48,D49:H49,D51:H51,D44 :E44,D50:E50")
If Not Intersect(Target, r) Is Nothing Then
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
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
Application.ScreenUpdating = True
End If
End Sub