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

Tan_23

New Member
Joined
Jan 21, 2018
Messages
2
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....

+++

Code:
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
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,723
Hi Tan. I don't know if this will work but U have named your wbs wrong in the code.
Code:
If DateDiff("d", Book1.Cells(1, 7), Book2.Cells(1, 7)) <> 0 Then
should be..
Code:
If DateDiff("d", Book1_Daily.Cells(1, 7), Book2_Archive.Cells(1, 7)) <> 0 Then
This is also wrong...
Code:
Book2.Parent.Close SaveChanges:=True
I think it should just be...
Code:
Workbooks(Book2_Archive.Name).Close SaveChanges:=True
HTH. Dave
edit: I missed the Welcome to the Board!
 
Last edited:

Tan_23

New Member
Joined
Jan 21, 2018
Messages
2
Thank you very much Dave. It still seems not to work. As keeps saving underneath the archived data without doing the dates testing. :(
 

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,723
Maybe post the code U are currently using. Trial a msgbox or 2 to see what's wromg...
Code:
msgbox Book1.Cells(1, 7) & "  " &  Book2.Cells(1, 7)
 msgbox DateDiff("d", Book1.Cells(1, 7), Book2.Cells(1, 7))
Dave
 

Watch MrExcel Video

Forum statistics

Threads
1,122,962
Messages
5,599,065
Members
414,281
Latest member
Engjamal2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top