CODEWITHSUNDEEP
vbaexcel
nabilah
nabilah

Reputation: 211

Duplicate Rows when rows is being copied and paste from one workbook to another

I have a code that allow me to filter based on the countries that i would like to copy and paste it from one workbook to another. However a problem that i face was when i run the code for more than once, duplicate rows is found. I am not sure how to make the improvement on the code to allow the codes to prevent a duplication of rows from happening. Below is the code that i currently have. It gave a duplication of the rows when copied from external workbook. The condition that i would like to search is "Singapore" and it appear more than once in the external workbook called "Active master project". Thus the code below will help to find all the rows contain "Singapore" and paste it into the other workbook that has a sheet called "New Upcoming Projects". However, when the codes is being run more than once, it will duplicate the rows that has already been copied previously. The external workbook will have new rows added each month thus the code below will allow to search for the "Singapore" and copy paste the rows into the another workbook. However, it also duplicate the previous rows that have been copied. Thus, I am a little stuck with the current code.

Sub UpdateNewUpcomingProj()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim copyFrom As Range
    Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel
    Dim strSearch As String

    Set wb1 = Application.Workbooks.Open("U:\Active Master Project.xlsm")
    Set ws1 = wb1.Worksheets("New Upcoming Projects")

    strSearch = "Singapore"
    With ws1

        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> I am assuming that the names are in Col A
        '~~> if not then change A below to whatever column letter
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        With .Range("A1:A" & lRow)
            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
            Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With

        .AutoFilterMode = False
    End With

    '~~> Destination File
    Set wb2 = ThisWorkbook
    Set ws2 = wb2.Worksheets("New Upcoming Projects")
     With ws2
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 2
        End If

       copyFrom.Copy .Rows(lRow)
    End With
End Sub

Below is the external workbook called Active Master Project which is used to refer to search for "Singapore" enter image description here

with the code above the information will be paste to the "New Upcoming Project" workbook. Look Like this: enter image description here However when i run the code again, the information above will be duplicated. Any help would be appreciated. Thank you :)

Upvotes: 0

Views: 975

Answers (2)

A.S.H
A.S.H

Reputation: 29332

It will be duplicated anytime you re-run the code because you are not checking for duplication in the destination sheet. One way to fix this is through checking for the duplicates before copying, for example on the projectId field...

But a simple and fast fix would be to remove the duplicated rows after the copy operation, like this:

right after copyFrom.Copy .Rows(lRow)

.Rows.RemoveDuplicates Array(1, 2, 3, 4), xlNo

This will remove duplicate rows based on all columns A, B, C and D. You probably would want to check based on the projectId, so the array would only be Array(2), or on more columns, just put their indexes in the Array. Sure it is not an esthetic solution, but avoids you to check for duplicates row by row from the source and the destination (two nested loops).

Upvotes: 1

Ambie
Ambie

Reputation: 4977

Assuming that you only want to check if your search string already exists, then you could just use another Find test and, if nothing is found, paste the results, like so...

Dim duplicateRng As Range

' // ... //

Set duplicateRng = .Cells.Find(What:=strSearch, _
                  After:=.Range("A1"), _
                  Lookat:=xlPart, _
                  LookIn:=xlFormulas, _
                  SearchOrder:=xlByRows, _
                  SearchDirection:=xlNext, _
                  MatchCase:=True)

If duplicateRng Is Nothing Then
    copyFrom.Copy .Rows(lRow)
End If

But if you want to check each cell in each row for a match with each cell in your paste rows then you'd really need to run a loop and test all the values.

Upvotes: 0

Related Questions