Forum Discussion

Jarvo's avatar
Jarvo
Copper Contributor
Mar 16, 2021
Solved

VBA formula for archiving

Hi everyone,   I've come across a very useful VBA formula for archiving data in my tables onto another sheet. The formula is as follows:   Application.EnableEvents = False If Target.Column = 4 A...
  • Jarvo 

     

    You placed the code for Selection Change Event on Current Sheet Module. Was it intentional or you did it by mistake?

    Ideally you should place the code for Change Event so that when Status gets changed in Status column of the Table on Current Sheet, the data will be copied to the Saved or Archive Sheet accordingly based on the Status selected.

     

    Please place the following code for Change Event on Current Sheet Module. In the attached I placed the code on Current Sheet Module for you to test it.

     

     

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl As ListObject
    Dim rng As Range
    Dim dws As Worksheet
    Dim dlr As Long
    
    Application.ScreenUpdating = False
    On Error GoTo Skip
    
    Set tbl = ActiveSheet.ListObjects("Table1")
    If Not Intersect(Target, tbl.DataBodyRange.Columns(4)) Is Nothing Then
        Application.EnableEvents = False
        Set rng = Intersect(ActiveSheet.Rows(Target.Row), Columns("A:G"))
        rng.Copy
        Select Case Target.Value
            Case "Save"
                Set dws = ThisWorkbook.Worksheets("Saved")
            Case "Closed"
                Set dws = ThisWorkbook.Worksheets("Archive")
        End Select
        dlr = dws.Cells(Rows.Count, "D").End(xlUp).Row + 1
        dws.Range("A" & dlr).PasteSpecial xlPasteAll
    End If
    Skip:
    Application.CutCopyMode = 0
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub

     

     

     

     

Resources