Delete old data in table after copy and paste macro

user_14165671 0
Viewed 877

I have developed a working macro in VBA that automatically opens a workbook and then copies the data and pastes it on a table in the workbook I am working on. I perform this task monthly.

The data set varies in rows every month but does not vary in columns.

I am running into issues when the data set in less rows than the previous month and I am forced to manually delete lines that remained in the table because the previous month had more rows.

I was hoping to add to my existing code to automatically delete the old data after pasting the new data.

I perform a manual keystroke of selecting the last row of new data and move down one cell in column A then do a Ctrl+Shift+Down+Right to grab the data and select delete. So essentially that is the task I am trying to replace.

Thanks.

Sub Import_File()

    Dim wbSourceData As Workbook
    Dim wbDestination As Workbook
    Dim wsSourceData As Worksheet
    Dim wsDestination As Worksheet
    Dim strFName As String
    Dim rng As Range
    Dim tbl As ListObject
    Dim Cl As Long
    Dim Rl As Long
    

    Set wbDestination = ThisWorkbook
    Set wsDestination = wbDestination.Sheets("DataTab")
    
    strFName = wbDestination.Worksheets("Macros").Range("C2").Value
    
    Set wbSourceData = Workbooks.Open(strFName)
    Set wsSourceData = wbSourceData.Worksheets(3)
    
    Set tbl = wsDestination.ListObjects("Data_Report")
    
    tbl.DataBodyRange.ClearContents
    
    With wsSourceData
    Cl = .Cells(2, .Columns.Count).End(xlToLeft).Column
    Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set rng = .Range(.Cells(2, "A"), .Cells(Rl, Cl))
    End With

    rng.Copy
    wsDestination.Range("A4").PasteSpecial xlValues
    
    Application.CutCopyMode = False
    
    wbSourceData.Close SaveChanges:=False

End Sub
vba excel
1 Answers

Overwrite Data Body Range

  • It is assumed that only values of the range will be copied.

The Code

Option Explicit

Sub overwriteDataBodyRangeTEST()
    Dim rg As Range: Set rg = Range("G2:K11")
    Dim tbl As ListObject: Set tbl = DataTab.ListObjects("Data_Report")
    overwriteDataBodyRange rg, tbl
End Sub

Sub overwriteDataBodyRange( _
        ByVal rg As Range, _
        ByVal tbl As ListObject)
    
    With tbl.DataBodyRange
        Dim rCount As Long: rCount = rg.Rows.Count
        Dim tCount As Long: tCount = .Rows.Count
        If rg.Columns.Count = .Columns.Count Then
            .Resize(rCount).Value = rg.Value
            If rCount < tCount Then
                 .Resize(tCount - rCount).Offset(rCount).Delete
            End If
        Else
            MsgBox "Different number of columns.", vbCritical, "Fail"
        End If
    End With

End Sub

EDIT

  • The following will copy the range to the table overwriting the previous data. If the previous data has more rows, they will be deleted.

Integrated

Option Explicit

Sub Import_File()
    
    ' Define Destination Table.
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets("DataTab")
    Dim tbl As ListObject: Set tbl = dws.ListObjects("Data_Report")
    
    ' Define Source Range.
    Dim sName As String: sName = dwb.Worksheets("Macros").Range("C2").Value
    Dim swb As Workbook: Set swb = Workbooks.Open(sName)
    Dim sws As Worksheet: Set sws = swb.Worksheets(3)
    Dim rng As Range
    Dim LastRow As Long
    Dim LastColumn As Long
    With sws
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastColumn = .Cells(2, .Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(2, "A"), .Cells(LastRow, LastColumn))
    End With
    
    ' Copy Source Range to Destination Table.
    With tbl.DataBodyRange
        Dim tCount As Long: tCount = .Rows.Count
        Dim rCount As Long: rCount = rng.Rows.Count
        .Resize(rCount).Value = rng.Value ' values only
        'rng.Copy .Resize(rCount) ' values, formats, and formulas
        If rCount < tCount Then
             .Resize(tCount - rCount).Offset(rCount).Delete
        End If
    End With
    
    ' Close Source Workbook (it was just read from).
    swb.Close SaveChanges:=False

End Sub
user_98140690
Related