Edit this code so it only work on a set range not entire sheet

[tonywatsonhelp]

Hi Everyone,

I have this code which is brilliant at dealling with row height on megred cells.

however its set up to do the entire page.

I just want it to work on range(C34:F34)

how can I edit it?

thanks

Tony

Private Sub Worksheet_Change(ByVal Target As Range)
  'If Target.Range("C10:G10") Is Nothing Then Exit Sub
    Dim NewRwHt As Single
    Dim cWdth As Single, MrgeWdth As Single
    Dim c As Range, cc As Range
    Dim ma As Range
    With Target
        If .MergeCells And .WrapText Then
            'ActiveSheet.Unprotect Password:="justme"
            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
            If NewRwHt < 60 Then
            NewRwHt = 60
            End If
            
            
            c.ColumnWidth = cWdth
            ma.MergeCells = True
            ma.RowHeight = NewRwHt
            cWdth = 0: MrgeWdth = 0
            'ActiveSheet.Protect Password:="justme"
            Application.ScreenUpdating = True
        End If
    End With
End Sub

 

[Joe4]

Add this at the beginning:

Dim rng as Range
Dim cell as Range

Set rng = Intersect(Target, Range("C34:F34"))
If rng is Nothing Then Exit Sub

You can then loop through your Target range (if more than one cell) by doingL

For each cell in rng