VBA Script to merge cells based on cell value

[sam1121]

I'm having difficulty finding a way to merge cells based on their values. Here’s what I need:

I have two dependent dropdown menus in columns D and E. When the value "DD9900" is selected in cell E12, I would like a script that merges E12 with E13 and also merges D12 with D13.

To clarify, when the value is DD9900 in E12, the following merges should occur:

-Cell E12 merges with E13

-Cell D12 merges with D13



Example:

ChatGPT helped me create a solution for a single cell (E12), but I need a code that applies the same logic to the entire range from E12 to E52.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Check if the changed cell is E12
    If Not Intersect(Target, Me.Range("E12")) Is Nothing Then
        Application.EnableEvents = False
        ' Clear any previous merges in D12:D13 and E12:E13
        If Me.Range("D12:D13").MergeCells Then Me.Range("D12:D13").Unmerge
        If Me.Range("E12:E13").MergeCells Then Me.Range("E12:E13").Unmerge

        ' Check the value in E12
        If Me.Range("E12").Value = "DD9900" Then
            ' Merge D12:D13 and E12:E13
            Me.Range("D12:D13").Merge
            Me.Range("E12:E13").Merge
        End If
        Application.EnableEvents = True
    End If
End Sub

Can anyone assist me with this?

Thank you!

 

[Joe4]

Welcome to the Board!

Try this code:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r As Long

    ' Exit if more than one cell updated
    If Target.CountLarge > 1 Then Exit Sub
    
    ' Check if the changed cell in E12:E52
    If Not Intersect(Target, Range("E12:E52")) Is Nothing Then
        ' Get row number of change
        r = Target.Row
        Application.EnableEvents = False
        ' Clear any previous merges in D12:D13 and E12:E13
        If Range("D" & r & ":D" & r + 1).MergeCells Then Range("D" & r & ":D" & r + 1).UnMerge
        If Range("E" & r & ":E" & r + 1).MergeCells Then Range("E" & r & ":E" & r + 1).UnMerge

        ' Check the value in column E
        If Range("E" & r).Value = "DD9900" Then
            ' Merge cells
            Range("D" & r & ":D" & r + 1).Merge
            Range("E" & r & ":E" & r + 1).Merge
        End If
        Application.EnableEvents = True
    End If
    
End Sub