Results 1 to 2 of 2

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

Threaded View

  1. #1
    Registered User
    Join Date
    07-20-2022
    Location
    Mexico
    MS-Off Ver
    365, 2021
    Posts
    2

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

    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)
    Last edited by davesexcel; 07-20-2022 at 03:58 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] Macro to copy and paste to another tab based on criteria
    By JJ11 in forum Excel Programming / VBA / Macros
    Replies: 7
    Last Post: 10-31-2019, 08:47 AM
  2. Copy Paste Macro Based on Criteria
    By Dan_B in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 02-08-2017, 03:32 AM
  3. Replies: 0
    Last Post: 10-05-2015, 12:07 PM
  4. Replies: 11
    Last Post: 05-12-2013, 11:30 AM
  5. [SOLVED] macro to copy/paste based on a criteria
    By winger in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 11-27-2012, 09:55 AM
  6. [SOLVED] Macro to Copy Data and Paste Values Based on cell criteria
    By Taislin in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 11-16-2012, 06:51 PM
  7. MS Excel 2003 macro to copy paste data in different sheets based on certain criteria
    By bhaktprahlad in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 09-02-2010, 06:17 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1