Applying VBA to other cells

[Joek88]

Hi all!

I have a VBA code that I made that works like this: In cell D3, I have a dropdown list that contains values of "2004", "2005", and "2006".

When "2004" is selected it will automatically merge, center text, and place a bold border around cells D5:D6. It will insert a text that says "Example A" into the merged cell.
When "2005" is selected it will automatically merge, center text, and place a bold border around cells D5:D6. It will insert a text that says "Example B" into the merged cell.
When "2006" is selected it will automatically merge, center text, and place a bold border around cells D5:D6. It will insert a text that says "Example C" into the merged cell.

When D3 is cleared, it clears all content from D5:D6, unmerges the cell, and removes the border.

How do I apply this VBA formula to other cells? I don't want to write code for every other cell in my spreadsheet. I created just small example to show what I want the code to do. So the selections in D3 will always be a constant and will not change (2004, 2005, or 2006). So, when I select "2004" I want it to create the border, merge and center, and add the "Example B" text to cell range D5:D6, HOWEVER, I also want it to create the border, merge and center, and add the "Example B" to the cells (green, blue, pink, orange) below in the picture also. It's like a duplicate of the VBA code to other cells. I hope this makes sense. I am just trying to get out of changing the VBA code for literally over a hundred different cells. I just want to basically copy and paste the code to other cells and it uses the logic only and applies it to that particular cell.

Here is my existing code that has been developed:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Not Intersect(Target, Range("D3")) Is Nothing Then
        ' Check if cell D3 contains 2004
        If Range("D3").Value = 2004 Then
            ' Check if cells D5 and D6 are already merged
            If Not Range("D5").MergeCells Then
                ' Merge cells D5 and D6
                Range("D5:D6").Merge
            End If
            ' Put "Example B" in the merged cell and center it
            With Range("D5:D6")
                .Value = "Example B"
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            ' Apply bold border around the merged cell
            With Range("D5:D6").Borders
                .LineStyle = xlContinuous
                .Weight = xlThick
            End With
        ElseIf Range("D3").Value = 2005 Then
            ' Check if cells D5 and D6 are already merged
            If Not Range("D5").MergeCells Then
                ' Merge cells D5 and D6
                Range("D5:D6").Merge
            End If
            ' Put "Example A" in the merged cell and center it
            With Range("D5:D6")
                .Value = "Example A"
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            ' Apply bold border around the merged cell
            With Range("D5:D6").Borders
                .LineStyle = xlContinuous
                .Weight = xlThick
            End With
        ElseIf Range("D3").Value = 2006 Then
            ' Check if cells D5 and D6 are already merged
            If Not Range("D5").MergeCells Then
                ' Merge cells D5 and D6
                Range("D5:D6").Merge
            End If
            ' Put "Example C" in the merged cell and center it
            With Range("D5:D6")
                .Value = "Example C"
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            ' Apply bold border around the merged cell
            With Range("D5:D6").Borders
                .LineStyle = xlContinuous
                .Weight = xlThick
            End With
        ElseIf Range("D3").Value = "" Then
            ' Check if cell D3 is blank
            ' Unmerge cell D5 and remove the border
            With Range("D5:D6")
                .UnMerge
                .Borders.LineStyle = xlNone
                ' Clear contents of cells D5:D6
                .ClearContents
            End With
        End If
    End If
End Sub

 

[rlv01]

How do I apply this VBA formula to other cells?

What is an example of some other cells you want to apply this code to?

 

[NoSparks]

You do realize that what you have would be in the 'ThisWorkbook' module and apply to all sheets in the workbook, right?