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)
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)