How can i make this macro work on multiple ranges?

[tonywatsonhelp]

Hi Everyone,

i have this macro that works great on the selected range
but i need it to work on other ranges, can i make this macro cover all the following ranges?

C120:G220?

Sub test1()


'On Error Resume Next
If Range("C120").Value = 0 Then
Range("A120").RowHeight = 15
Else
'Resize row code

    With Range("C120:G120")
        If .MergeCells And .WrapText Then

            Set c = Range("C120").Cells(1, 1)
            cWdth = c.ColumnWidth
            Set ma = c.MergeArea
            For Each cc In ma.Cells
                MrgeWdth = MrgeWdth + cc.ColumnWidth + 1
            Next
     
            ma.MergeCells = False
            c.ColumnWidth = MrgeWdth
            c.EntireRow.AutoFit
            
            NewRwHt = c.RowHeight
            If NewRwHt < 15 Then
            NewRwHt = 15
            End If
            
            
            c.ColumnWidth = cWdth
            ma.MergeCells = True
            ma.RowHeight = NewRwHt
            cWdth = 0: MrgeWdth = 0

            
        End If
    End With
  End If

End Sub

 

[Joe4]

Try something like this.

Sub test1()

    Dim r As Long
    
    Application.ScreenUpdating = False

'   Loop through rows 120 to 220
    For r = 120 To 220

'       On Error Resume Next
        If Cells(r, "C").Value = 0 Then
            Cells(r, "A").RowHeight = 15
        Else
'       Resize row code
            With Range(Cells(r, "C"), Cells(r, "G"))
                If .MergeCells And .WrapText Then

                    Set c = Cells(r, "C").Cells(1, 1)
                    cWdth = c.ColumnWidth
                    Set ma = c.MergeArea
                    For Each cc In ma.Cells
                        MrgeWdth = MrgeWdth + cc.ColumnWidth + 1
                    Next
     
                    ma.MergeCells = False
                    c.ColumnWidth = MrgeWdth
                    c.EntireRow.AutoFit
            
                    NewRwHt = c.RowHeight
                    If NewRwHt < 15 Then
                        NewRwHt = 15
                    End If
                        
                    c.ColumnWidth = cWdth
                    ma.MergeCells = True
                    ma.RowHeight = NewRwHt
                    cWdth = 0: MrgeWdth = 0
           
                End If
            End With
        End If
    Next r
    
    Application.ScreenUpdating = True

End Sub

I would also suggest declaring all your variables, like I did with "r". If you then turn on "Option Explicit", that often helps in debugging and identifies typos in your variables.
See: Option Explicit in Excel VBA

 

[tonywatsonhelp]

Works perfect thank you Joe

 

[Joe4]

You are welcome.
I hope it makes sense to you what I did. If you have any questions about it, please feel free to ask me.

 

[tonywatsonhelp]

understood it perfectly once it was written, thanks very much