Merging and unmerging cells based on another cell's value

[cpg84]

I want to merge C2:F2 if B2 has a value in it and unmerge if it doesn't.

I found code online and have tweaked it so the merging works. However, I am having trouble with unmerging the cells when there is no value in B2.

Does anyone know how to manipulate this coding so it works? I am aware that there is an exit sub statement for when rng1 is nothing, so I know that has to change. Just having trouble with putting the right statement in the right place.

I also assume I don't need "rng2" because I am only using one range (B:B).

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Target, Range("B:B"))
If rng1 Is Nothing Then Exit Sub
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
For Each rng2 In rng1
'If rng2.Row > 1 Then
If (rng2.Row - 2) Mod 1 = 0 Then
With rng2.Offset(0, 1).Resize(1, 4).Cells
.MergeCells = True
.WrapText = True
End With
End If
'End If
Next
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

If I need to clarify anything, please let me know

Thanks

 

[Cubist]

My advice is to avoid merge cells if possible, but try:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng1 As Range
    Set rng1 = Intersect(Target, Range("B:B"))
    
    If rng1 Is Nothing Then Exit Sub
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    For Each rng1 In Target
        If Not IsEmpty(rng1) Then
            ' If B2 has a value, merge C2:F2
            If rng1.Row = 2 Then
                With rng1.Offset(0, 1).Resize(1, 4)
                    .MergeCells = True
                    .WrapText = True
                End With
            End If
        Else
            ' If B2 is empty, unmerge C2:F2
            If rng1.Row = 2 Then
                With rng1.Offset(0, 1).Resize(1, 4)
                    .UnMerge
                End With
            End If
        End If
    Next
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

 

[cpg84]

Thank you