Copy rows without triggering a macro VBA

There's a few questions relating to this subject but I'm struggling a bit.

I have a MASTER sheet that stores various information. I use Column B to hide/unhide other columns. So for each different value entered in Column B, it will display the appropriate Columns. e.g. If X is entered in Column B, Col C:F will be displayed and Col G:I will be hidden.

This works fine but I want to automatically copy identical values from this sheet to separate sheets. e.g. grab all X's in MASTER and copy to a separate sheet that contains only X's.

I can do this but only through the use of a macro that needs to be triggered. This isn't very efficient if I need to copy numerous rows. Especially if you've only updated 1 row but need to copy everything.

I want to automatically auto-copy as soon as a value is entered. Without needing to trigger a macro

This is the script the hides/unhides specific columns in the 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

As I can't add a separate Worksheet_Change to this script to auto-copy across I'm a bit confused in how to do this

I'm currently using the script below. This copies the appropriate rows to the respective sheet. But it only works when triggered. I'm hoping to automatically copy the row once filled in.

@Gexas, how is this?

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

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, sht1 As Worksheet, sht2 As Worksheet

    Set sht1 = Worksheets("MASTER")
    Set sht2 = Worksheets("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
728x90

2 Answers Copy rows without triggering a macro VBA

Filter and Copy

If you move the 'Sub' into the sheet code (Master), you can lose the 'sht1' in it like you did in the 'Private Sub', if not just add the line FilterAndCopy appropriately into the 'Private Sub'.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo safe_exit

    ' Something has changed in Column "B"
    If Not Intersect(Target, Range("B:B")) Is Nothing Then

        Application.EnableEvents = False

    ' *******************
        FilterAndCopy ' *
    ' *******************

        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


'****************
Sub FilterAndCopy()

    Dim rng As Range, sht1 As Worksheet, sht2 As Worksheet

    Set sht1 = Worksheets("MASTER")
    Set sht2 = Worksheets("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
'****************

4 months ago

Worksheet_Change event can have both of your functions inside. Since code is read from first to last line, with with order VBA will copy content from your second code and later hides columns. Code below should work, assuming everything else is good with. Note that I can not test it and did not check for other errors. Just changed order.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, sht1 As Worksheet, sht2 As Worksheet

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

    sht2.UsedRange.ClearContents

    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        On Error GoTo safe_exit
        Application.EnableEvents = False

        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

        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

4 months ago