Macro to copy and paste data on another WB based on criteria, need help with duplicates

[FariAb]

Hi everyone! I'm currently working on developing a macro to make the information in a recent workbook (LibroOrigen) be copied to a database workbook (LibroDestino) if the status is "Paid" or "Cancelled", this part does work, but I'd like for the macro to prevent duplicates being copied to the database workbook (LibroDestino). Does anyone know if that's possible? Here is the code I'm using:

Sub ImportData()

'Definir Origen

Dim wbLibroOrigen As Workbook

Dim wsHojaOrigen As Worksheet

'Definir Destino

Dim wbLibroDestino As Workbook

Dim wsHojaDestino As Worksheet

'Definir Ruta

Dim Ruta As String

Ruta = *Ruta*

'Data Destino

Set wbLibroDestino = Workbooks(ThisWorkbook.Name)

Set wsHojaDestino = wbLibroDestino.Worksheets("Overview")

'Data Origen

Set wbLibroOrigen = Workbooks.Open(Ruta)

Set wsHojaOrigen = wbLibroOrigen.Worksheets("Overview 2022")

'Definir variables

Dim DataRg As Range

Dim DataCell As Range

Dim P As Long

Dim J As Long

Dim I As Long

'Set variables

P = wsHojaOrigen.UsedRange.Rows.Count

Q = wsHojaDestino.UsedRange.Rows.Count


'If to relate variables

If I = 1 Then

If Application.WorksheetFunction.CountA(wsHojaDestino.UsedRange) = 0 Then Q = 0

End If


'Rango for Overview

Set DataRg = wsHojaOrigen.Range("AD91:AD500" & P)

On Error Resume Next

Application.ScreenUpdating = False


'Apply Loop

For I = 1 To DataRg.Count


'Paid Condition

If CStr(DataRg(I).Value) = "Paid" Then


'Command to copy cells

DataRg(I).EntireRow.Copy Destination:=wsHojaDestino.Range("A" & Q + 1)

Q = Q + 1

End If

Next

Application.ScreenUpdating = True


'Apply Loop

For I = 1 To DataRg.Count


'Cancelled Condition

If CStr(DataRg(I).Value) = "Cancelled" Then


'Command to copy cells

DataRg(I).EntireRow.Copy Destination:=wsHojaDestino.Range("A" & Q + 1)

Q = Q + 1

End If
Next
Application.ScreenUpdating = True
Workbooks(wbLibroOrigen.Name).Close Savechanges:=False
End Sub

(Some parts are in English and some in Spanish but I believe it is understandable)

 

[Joe4]

Duplicate to: Copy data based on criteria to other Workbook without duplicates and delete in origin workbook

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread. If you do not receive a response, you can "bump" it by replying to it yourself, though we advise you to wait 24 hours before doing so, and not to bump a thread more than once a day.