CODEWITHSUNDEEP
excelvbacopy
Chopin
Chopin

Reputation: 214

Automatically copy rows to a new sheet when a cell is is changed excel VBA

I know this has been posted as a question numerous times. But I just can't get it working, I've tried numerous methods.

I have code that auto copies specific rows to a new sheet when a specific value is entered into Column B. But this only occurs when assign the marco to a button and manually trigger it. This isn't very efficient when copying over numerous rows. Especially when you're copying over hundreds of rows with only the last few actually changing. I'm hoping this will automatically happen when that value is entered.

So my first sheet is called MASTER and the second sheet is called CON. When Change of Numbers is entered into the MASTER I want to automatically copy these rows into sheet CON.

This code below is situated in The Master Sheet (which is the first). This script is used to hide/unhide specific Columns when values are entered into Column B.

MASTER SHEET

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        On Error GoTo safe_exit
        Application.EnableEvents = False
        Dim t As Range
        For Each t In Intersect(Target, Range("B:B"))
            Select Case (t.Value)
                Case "Change of Numbers"
                    Columns("B:BP").EntireColumn.Hidden = False
                    Columns("H:BL").EntireColumn.Hidden = True
                    'do nothing
            End Select
        Next t

    End If

safe_exit:
    Application.EnableEvents = True
End Sub

The following script is situated in sheet CON (which is the second sheet). This script is used to auto-copy the rows where X is entered into Column A in the Master sheet. However I have to assign this macro to a button on this sheet. It then grabs all the designated rows each time the macro is triggered.

CON SHEET

Option Explicit

Sub FilterAndCopy()
    Dim sht1 As Worksheet, sht2 As Worksheet

    Set sht1 = Sheets("MASTER")
    Set sht2 = Sheets("CON")

    sht2.UsedRange.ClearContents

    With Intersect(sht1.Columns("B:BP"), sht1.UsedRange)
        .Cells.EntireColumn.Hidden = False ' unhide columns
        If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False

        .AutoFilter field:=1, Criteria1:="Change of Numbers"

        .Range("A:F, BL:BO").Copy Destination:=sht2.Cells(2, "B")
        .Parent.AutoFilterMode = False

        .Range("H:BK").EntireColumn.Hidden = True ' hide columns
    End With
End Sub

But this still doesn't work without manually running the script.

Upvotes: 1

Views: 2851

Answers (2)

K.Dᴀᴠɪs
K.Dᴀᴠɪs

Reputation: 10139

Your code is not watching for any events to take place. The particular event you want is the Worksheet_Change() event, which is what I see in the second code snippet you provided.

So, you can go about this two ways. One, copy and paste the entire code into this event, or two (which is usually preferred) would be to call the sub within the event handler.

However, for the Worksheet to watch for the Change Event, you need to place this into the worksheet's code module. In the VBE, you will see this as Sheet1, Sheet2, etc.

My recommendation, place your Sub FilterAndCopy() in a standard module. Then in Sheet1's code module, add:

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo ErrHandler

    'Test if criteria is met
    If Intersect(Target, Columns("A")) Is Nothing Then
        Exit Sub
    ElseIf Target.Value = "mySpecificValue" Then
        Application.EnableEvents = False
        FilterAndCopy

        Dim t As Range
        For Each t In Intersect(Target, Range("a:a"))
            Select Case UCase(t.Value)
                Case "X"
                    Columns("B:C").EntireColumn.Hidden = True
                    Columns("D:E").EntireColumn.Hidden = False
                Case "Y"
                    Columns("B:C").EntireColumn.Hidden = False
                    Columns("D:E").EntireColumn.Hidden = True
                Case Else
                    'do nothing
            End Select
        Next t

    End If

ErrHandler:

    If Err.Number <> 0 Then
        Rem: Optional - Error message and/or err recovery
    End If

    Application.EnableEvents = True

End Sub

Upvotes: 2

urdearboy
urdearboy

Reputation: 14580

If you first sub works exactly as intended all you need to do is Call the sub from your Worksheet_Change event. Just to be clear, as your Worksheet_Change macro is set-up, it will only call if the change is made on Column A 

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
    On Error GoTo Finalize 'to re-enable the events
        FilterAndCopy

Finalize:
    Application.EnableEvents = True
End Sub

Upvotes: 2

Related Questions