Reference a cell but keep formatting of text from source cell

[phmalu]

I've got this code so that whenever I change a certain cell others are automatically updated considering both content and formatting rules. How can I add more lines so that it applies to several different group of cells? Let's say I also want to copy contents and formatting from 'W2' into 'I2,I7,I12,I17,I26,I31,I36,I41,I50,I55,I60,I65'? If I try to duplicate the code it won't work so I'm sure some code tweaking is also needed but my VBA skills are very limited...

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Target.Address = [X2].Address Or changing Then Exit Sub
    changing = True
    [X2].Copy [J2,J7,J12,J17,J26,J31,J36,J41,J50,J55,J60,J65]
    changing = False

End Sub

Thank you!

 

[Alex Blakenburg]

I am not sure hard coding this stuff into a Worksheet_Change macro is a good idea but this code might work for you for now.

In the code you need to maintain:-
1) StrCells - the cells you want to action
2) A pair of Case Statements - The cell you want to copy from on the Case line and the list of cells you want to copy to on the next line.
The X2 is per your example the others are made up.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim changing As Boolean
    Dim StrCells As String
    Dim tgtAddress As String
    
    StrCells = "X2,W2,Y2"                           ' cells to copy

    tgtAddress = Target.Address(False, False)       ' without $
    
    If InStr(StrCells, tgtAddress) <> 0 And Not changing Then
        changing = True
        
        Select Case tgtAddress
            Case "X2"
                Target.Copy [J2,J7,J12,J17,J26,J31,J36,J41,J50,J55,J60,J65]
            Case "W2"
                Target.Copy [K2,K7,K12,K17,K26,K31,K36,K41,K50,K55,K60,K65]
            Case "Y2"
                Target.Copy [L2,L7,L12,L17,L26,L31,L36,L41,L50,L55,L60,L65]
                
        End Select
            
        changing = False
    End If    

End Sub

 

[Alex Blakenburg]

Oh I meant to remove the lines referring to "changing" they don't do anything, since their life ends when they hit the exit sub.
Even without it, it only tries to execute twice but you can even stop the 2nd iteration by turning off/on EnableEvents.

Here is the modified code.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim StrCells As String
    Dim tgtAddress As String
    
    StrCells = "X2,W2,Y2"                           ' cells to copy
    tgtAddress = Target.Address(False, False)       ' without $
    
    If InStr(StrCells, tgtAddress) <> 0 Then
        Application.EnableEvents = False
        
        Select Case tgtAddress
            Case "X2"
                Target.Copy [J2,J7,J12,J17,J26,J31,J36,J41,J50,J55,J60,J65]
            Case "W2"
                Target.Copy [K2,K7,K12,K17,K26,K31,K36,K41,K50,K55,K60,K65]
            Case "Y2"
                Target.Copy [L2,L7,L12,L17,L26,L31,L36,L41,L50,L55,L60,L65]
                
        End Select
        Application.EnableEvents = True
            
    End If    
End Sub

 

[phmalu]

Oh I meant to remove the lines referring to "changing" they don't do anything, since their life ends when they hit the exit sub.
Even without it, it only tries to execute twice but you can even stop the 2nd iteration by turning off/on EnableEvents.

Here is the modified code.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim StrCells As String
    Dim tgtAddress As String
   
    StrCells = "X2,W2,Y2"                           ' cells to copy
    tgtAddress = Target.Address(False, False)       ' without $
   
    If InStr(StrCells, tgtAddress) <> 0 Then
        Application.EnableEvents = False
       
        Select Case tgtAddress
            Case "X2"
                Target.Copy [J2,J7,J12,J17,J26,J31,J36,J41,J50,J55,J60,J65]
            Case "W2"
                Target.Copy [K2,K7,K12,K17,K26,K31,K36,K41,K50,K55,K60,K65]
            Case "Y2"
                Target.Copy [L2,L7,L12,L17,L26,L31,L36,L41,L50,L55,L60,L65]
               
        End Select
        Application.EnableEvents = True
           
    End If   
End Sub

The original code I got works for just one group of cells or cases as you quoted. Unfortunately your code won't work the way I'd like it to.
All I wanna do is copy content & formatting from one cell to several others. Let's say I type "Apples" in A1, change color to red, put borders around the cell and set size to 16. Then when I hit enter everything is copied from this source cell to all destination cells I've specified in the macro.

 

[phmalu]

The original code I got works for just one group of cells or cases as you quoted. Unfortunately your code won't work the way I'd like it to.
All I wanna do is copy content & formatting from one cell to several others. Let's say I type "Apples" in A1, change color to red, put borders around the cell and set size to 16. Then when I hit enter everything is copied from this source cell to all destination cells I've specified in the macro.

It was my mistake, your code is working the way it should. Thank you!

 

[Alex Blakenburg]

Glad it worked for you.

 

[phmalu]

Glad it worked for you.

Btw, is it possible to tweak the code somehow so it only copies font style, size, color and cell background but not other parameter besides those like conditional formatting rules?
Or I could also copy content using a reg formular then with VBA just to copy formatting (font style, size, color and cell background) but not conditional formatting rules...

Thank you once again!

 

[Alex Blakenburg]

To be honest what you are trying to do seems a rather unusual use of Excel.
Since you seem to want to copy everything except conditional formatting, you could go the other way ie copy everything and then remove the conditional formatting.
That would look like this:-

            Case "X2"
                Target.Copy [J2,J7,J12,J17,J26,J31,J36,J41,J50,J55,J60,J65]
                Target.Copy [J2,J7,J12,J17,J26,J31,J36,J41,J50,J55,J60,J65].FormatConditions.Delete

 

[phmalu]

.FormatConditions.Delete

After adding the new line I got "Error 1004 Copy method of Range Class failed"
Tried to debug and the new line was highlighted

 

[Alex Blakenburg]

Oops sorry.

Format should be:-

            Case "X2"
                Target.Copy [J2,J7,J12,J17,J26,J31,J36,J41,J50,J55,J60,J65]
                [J2,J7,J12,J17,J26,J31,J36,J41,J50,J55,J60,J65].FormatConditions.Delete

I have made a couple of other changes that you should replicate:

• Added - On Error GoTo Finish at the top
• Added - Finish:
  Just before the End Sub
• Moved the - Application.EnableEvents = True
  To under the Finish:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim StrCells As String
    Dim tgtAddress As String
    
    On Error GoTo Finish
    
    StrCells = "X2,W2,Y2"                           ' cells to copy

    tgtAddress = Target.Address(False, False)       ' without $
    
    If InStr(StrCells, tgtAddress) <> 0 Then
        Application.EnableEvents = False
        
        Select Case tgtAddress
            Case "X2"
                Target.Copy [J2,J7,J12,J17,J26,J31,J36,J41,J50,J55,J60,J65]
                [J2,J7,J12,J17,J26,J31,J36,J41,J50,J55,J60,J65].FormatConditions.Delete
            Case "W2"
                Target.Copy [K2,K7,K12,K17,K26,K31,K36,K41,K50,K55,K60,K65]
                [K2,K7,K12,K17,K26,K31,K36,K41,K50,K55,K60,K65].FormatConditions.Delete
            Case "Y2"
                Target.Copy [L2,L7,L12,L17,L26,L31,L36,L41,L50,L55,L60,L65]
                [L2,L7,L12,L17,L26,L31,L36,L41,L50,L55,L60,L65].FormatConditions.Delete
        End Select
            
    End If
    
Finish:
    Application.EnableEvents = True

End Sub