VBA help-Check if book 1 data already exist in book 2 and if not append, otherwise exit macro

[Tan_23]

Hi all,

I am new to VBA and I tried to write a macro to append data from Book 1 (active workbook where will have the macro) which is updated daily, to Book 2 ( close Archiving excel) which is only used for queries. Book 1 and Book 2 have the same column headers in row 1, with dates in column A. The range copied from Book 1 is dynamic while columns fixed. Note for Book 1 the Date in column A is the same for all the rows in the range.

I have managed to do the copying macro, however I really struggle on how to add a "Condition" before macro copy the data from Book 1 to Book 2. The test should compare the Date in Book 1 (as its the same for all the entries in column A) with the Dates in Book 2, if finds the date from Book 1 in Book 2, that means the data have already archived - therefore should exit the macro and show an exit msg box. If not find the date, then macro should continue and append the data from Book 1 to Book 2 and show a completed msg box.

As I couldn't do the test as I described above i tried to compare cell values but didn't manage to get that to work either.

I would really appreciate your input and your help... as I am stuck! Below what I have done so far....

+++

Private Sub Archive_Data()


    Dim Book1_Daily As Worksheet
    Dim Book2_Archive As Worksheet
    Dim Source As String
    Dim Target As String
    Dim Spath As String
    Dim Tpath As String
    Dim rngSource As Range
    Dim rngTarget As Range
    
    
    Application.ScreenUpdating = False


    Source = "Book1 Daily Data"
    Spath = "C:\\Desktop\Book1.xlsm"
    Tpath = "C:\\Desktop\Book2.xlsx"
    Target = "Book2 Archive Data"


    Application.EnableCancelKey = xlDisabled


    
    Set Book1_Daily = Workbooks.Open(Spath).Sheets(Source)
    Set Book2_Archive = Workbooks.Open(Tpath).Sheets(Target)
    Set rngSource = Range(Book1_Daily.Range("A2"), Book1_Daily.Cells.SpecialCells(xlCellTypeLastCell))
    Set rngTarget = Book2_Archive.Range("A" & Rows.Count).End(xlUp).Offset(1)
    


    If DateDiff("d", Book1.Cells(1, 7), Book2.Cells(1, 7)) <> 0 Then 'This is my attempt for the date test by referring to cells which have linked the max date'
       
    MsgBox "Data Already Archived"


    Exit Sub


    Else


    rngTarget.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value


    Book2.Parent.Close SaveChanges:=True
    
   
    Application.ScreenUpdating = True


        
    End If
    
    
    End Sub

+++


Many thanks for your help!!!

Tan

 

[NdNoviceHlp]

Hi Tan. I don't know if this will work but U have named your wbs wrong in the code.

If DateDiff("d", Book1.Cells(1, 7), Book2.Cells(1, 7)) <> 0 Then

should be..

If DateDiff("d", Book1_Daily.Cells(1, 7), Book2_Archive.Cells(1, 7)) <> 0 Then

This is also wrong...

Book2.Parent.Close SaveChanges:=True

I think it should just be...

Workbooks(Book2_Archive.Name).Close SaveChanges:=True

HTH. Dave
edit: I missed the Welcome to the Board!

 

[Tan_23]

Thank you very much Dave. It still seems not to work. As keeps saving underneath the archived data without doing the dates testing.

 

[NdNoviceHlp]

Maybe post the code U are currently using. Trial a msgbox or 2 to see what's wromg...

msgbox Book1.Cells(1, 7) & "  " &  Book2.Cells(1, 7)
 msgbox DateDiff("d", Book1.Cells(1, 7), Book2.Cells(1, 7))

Dave