How can i make this macro work on multiple ranges?

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,744
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
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?




VBA Code:
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
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,980
Office Version
  1. 365
Platform
  1. Windows
Try something like this.
VBA Code:
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
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,980
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Feb 24, 2014
Messages
2,744
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
understood it perfectly once it was written, thanks very much
 

Watch MrExcel Video

Forum statistics

Threads
1,130,029
Messages
5,639,624
Members
417,101
Latest member
amoverton2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top