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