Use VBA to check if source date is present on target sheet before copying data

[Doge Robert]

Hey there.

I have a macro that copies data from one sheet to the first empty row of another... No problem there.
In row H of both datasets is a date. I would like my macro to check if the date in row H of the source sheet (all rows have the same date) is present somewhere in row H of the target sheet, BEFORE data is copied and if the date is present, stop the macro and make a pop up with the text "Data is already copied for specified date".

Any help is appreciated.

This is the macro, I'm currently using:

Sub CopyDataToHistory()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long

'Set Variables
Set wsCopy = Sheets("TblHistoriskeData") 'Sourcedata sheetname
Set wsDest = Sheets("Historiske Data") 'Target sheetname
'Find Last Row in Copy Range
CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row

'Find 1st blank row in Destination Range - Offset 1 row
DestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

'Copy & Paste Data
wsCopy.Range("A2:h" & CopyLastRow).Copy _
wsDest.Range("A" & DestLastRow)

End Sub

Edit: Typos

 

[dmt32]

Hi,
untested but see if this update to your code does what you want

Sub CopyDataToHistory()
    Dim DateExists  As Boolean
    Dim wsCopy      As Worksheet, wsDest As Worksheet
    Dim CopyLastRow As Long, DestLastRow As Long
    
    'Set Variables
    Set wsCopy = ThisWorkbook.Worksheets("TblHistoriskeData")        'Sourcedata sheetname
    Set wsDest = ThisWorkbook.Worksheets("Historiske Data")        'Target sheetname
    
    'check if date exists in destination sheet column H
    DateExists = Not IsError(Application.Match(CLng(wsCopy.Cells(2, 8).Value), wsDest.Columns(8), 0))
    
    If Not DateExists Then
        'Find Last Row in Copy Range
        CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
        
        'Find 1st blank row in Destination Range - Offset 1 row
        DestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
        
        'Copy & Paste Data
        wsCopy.Range("A2:H" & CopyLastRow).Copy wsDest.Range("A" & DestLastRow)
        
    Else
    
        MsgBox "Data Is already copied For specified date", 48, "Date Exists"
        
    End If
    
End Sub

I have assumed dates in Column H are real dates

Dave

 

[Doge Robert]

Hi,
untested but see if this update to your code does what you want

Sub CopyDataToHistory()
    Dim DateExists  As Boolean
    Dim wsCopy      As Worksheet, wsDest As Worksheet
    Dim CopyLastRow As Long, DestLastRow As Long
   
    'Set Variables
    Set wsCopy = ThisWorkbook.Worksheets("TblHistoriskeData")        'Sourcedata sheetname
    Set wsDest = ThisWorkbook.Worksheets("Historiske Data")        'Target sheetname
   
    'check if date exists in destination sheet column H
    DateExists = Not IsError(Application.Match(CLng(wsCopy.Cells(2, 8).Value), wsDest.Columns(8), 0))
   
    If Not DateExists Then
        'Find Last Row in Copy Range
        CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
       
        'Find 1st blank row in Destination Range - Offset 1 row
        DestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
       
        'Copy & Paste Data
        wsCopy.Range("A2:H" & CopyLastRow).Copy wsDest.Range("A" & DestLastRow)
       
    Else
   
        MsgBox "Data Is already copied For specified date", 48, "Date Exists"
       
    End If
   
End Sub

I have assumed dates in Column H are real dates

Dave

Thank you very much. It seems to be working exactly, as I envisioned.

 

[dmt32]

most welcome glad suggestion does what you want & appreciate your feedback

Dave