Forum Discussion

Chongsian's avatar
Chongsian
Copper Contributor
Jul 16, 2023

Why only some duplicates appear?

Hi,

 

I will like some help with my macro below. So whenever I run this macro on the same selected file, there will be 2 new rows with duplicates appearing. And the same 2 entries will just keep getting added for how many times I run the macro. I have checked it against excel highlight duplicate and excel identify the 2 entries as duplicates but the macro dont seem to deem them as duplicates. This is the last bit which I have issues troubleshooting. Thanks for the help!

 

 

Sub ProcessSelectedFile()
    Dim selectedFile As Variant
    Dim wbSelected As Workbook
    Dim wsRROB As Worksheet
    Dim wsCurrent As Worksheet
    Dim lastRow As Long
    Dim i As Long, newRow As Long
    Dim arrValues() As Variant
    
    ' Step 1: Select Excel file
    selectedFile = Application.GetOpenFilename("Excel Files (*.xls;*.xlsx), *.xls;*.xlsx")
    
    ' Check if a file was selected
    If selectedFile = False Then Exit Sub
    
    ' Step 2: Open selected file and assign worksheets to variables
    Set wbSelected = Workbooks.Open(selectedFile)
    Set wsRROB = wbSelected.Sheets("RR  OB")
    Set wsCurrent = ThisWorkbook.ActiveSheet ' Change ThisWorkbook to the workbook where the macro is running if needed
    
    ' Step 3: Iterate through rows in "RR OB" worksheet
    lastRow = wsRROB.Cells(wsRROB.Rows.Count, "B").End(xlUp).Row
    
    ' Condition 1: Check if value in column B is in the array
    arrValues = Array("Value1", "Value2", "Value3", "Value4")
    
    ' Iterate through each row in "RR OB" worksheet
    For i = 3 To lastRow
        ' Condition 1: Check if value in column B is in the array
        If Not IsInArray(wsRROB.Cells(i, "B").value, arrValues) Then
            GoTo NextRow
        End If
        
        ' Step 1: Search for matching value in column B of current worksheet starting from row 6
        Dim currentRow As Long
        
        For currentRow = 6 To wsCurrent.Cells(wsCurrent.Rows.Count, "B").End(xlUp).Row
            ' Need to check 3 values to ensure rows found in both files are the same
            If wsCurrent.Cells(currentRow, "B").value = wsRROB.Cells(i, "AE").value And _
               wsCurrent.Cells(currentRow, "D").value = wsRROB.Cells(i, "C").value And _
               wsCurrent.Cells(currentRow, "E").value = wsRROB.Cells(i, "X").value Then
                    ' Condition 2 met: Copy value from column F of "RR OB" to column F of current worksheet
                    wsCurrent.Cells(currentRow, "F").value = wsRROB.Cells(i, "F").value
                    GoTo NextRow
                    Else
                    ' Continue searching for the next match within the same i iteration
                    GoTo NextcurrentRow
            End If
            
NextcurrentRow:
        Next currentRow
        
        ' If no match was found, copy values to new row in current worksheet
        newRow = wsCurrent.Cells(wsCurrent.Rows.Count, "B").End(xlUp).Row + 1 ' Next available row
        
        wsCurrent.Cells(newRow, "B").value = wsRROB.Cells(i, "AE").value
        wsCurrent.Cells(newRow, "C").value = wsRROB.Cells(i, "U").value
        wsCurrent.Cells(newRow, "D").value = wsRROB.Cells(i, "C").value
        wsCurrent.Cells(newRow, "E").value = wsRROB.Cells(i, "X").value
        wsCurrent.Cells(newRow, "F").value = wsRROB.Cells(i, "F").value
        wsCurrent.Cells(newRow, "G").value = wsRROB.Cells(i, "B").value
        
NextRow:
    Next i
    
    ' Close selected file and clean up
    wbSelected.Close SaveChanges:=False
    Set wsRROB = Nothing
    Set wsCurrent = Nothing
    Set wbSelected = Nothing
    
    ' Display completion message
    MsgBox "File processed successfully!"
End Sub

Function IsInArray(ByVal value As Variant, arr As Variant) As Boolean
    Dim element As Variant
    For Each element In arr
        If element = value Then
            IsInArray = True
            Exit Function
        End If
    Next element
    IsInArray = False
End Function

 

  • LeonPavesic's avatar
    LeonPavesic
    Silver Contributor

    Hi Chongsian

    To address the duplicate issue, a variable named duplicateFound has been introduced. This variable is used to track whether a duplicate has been found within the iteration. If a match is found while searching for duplicates in the current worksheet, the duplicateFound variable is set to True, and the loop is exited using Exit For.

    In the subsequent logic, if duplicateFound is False, indicating no match was found, the values are copied to a new row in the current worksheet.

    By incorporating the duplicateFound variable and the appropriate Exit For statement, the macro now ensures that only one copy of the duplicate entries is added to the worksheet.

    Sub ProcessSelectedFile()
    Dim selectedFile As Variant
    Dim wbSelected As Workbook
    Dim wsRROB As Worksheet
    Dim wsCurrent As Worksheet
    Dim lastRow As Long
    Dim i As Long, newRow As Long
    Dim arrValues() As Variant
    Dim duplicateFound As Boolean

    ' Step 1: Select Excel file
    selectedFile = Application.GetOpenFilename("Excel Files (*.xls;*.xlsx), *.xls;*.xlsx")

    ' Check if a file was selected
    If selectedFile = False Then Exit Sub

    ' Step 2: Open selected file and assign worksheets to variables
    Set wbSelected = Workbooks.Open(selectedFile)
    Set wsRROB = wbSelected.Sheets("RR OB")
    Set wsCurrent = ThisWorkbook.ActiveSheet ' Change ThisWorkbook to the workbook where the macro is running if needed

    ' Step 3: Iterate through rows in "RR OB" worksheet
    lastRow = wsRROB.Cells(wsRROB.Rows.Count, "B").End(xlUp).Row

    ' Condition 1: Check if value in column B is in the array
    arrValues = Array("Value1", "Value2", "Value3", "Value4")

    ' Iterate through each row in "RR OB" worksheet
    For i = 3 To lastRow
    ' Condition 1: Check if value in column B is in the array
    If Not IsInArray(wsRROB.Cells(i, "B").Value, arrValues) Then
    GoTo NextRow
    End If

    ' Step 1: Search for matching value in column B of current worksheet starting from row 6
    Dim currentRow As Long
    duplicateFound = False

    For currentRow = 6 To wsCurrent.Cells(wsCurrent.Rows.Count, "B").End(xlUp).Row
    ' Need to check 3 values to ensure rows found in both files are the same
    If wsCurrent.Cells(currentRow, "B").Value = wsRROB.Cells(i, "AE").Value And _
    wsCurrent.Cells(currentRow, "D").Value = wsRROB.Cells(i, "C").Value And _
    wsCurrent.Cells(currentRow, "E").Value = wsRROB.Cells(i, "X").Value Then
    ' Condition 2 met: Copy value from column F of "RR OB" to column F of current worksheet
    wsCurrent.Cells(currentRow, "F").Value = wsRROB.Cells(i, "F").Value
    duplicateFound = True
    Exit For
    End If
    Next currentRow

    ' If no match was found, copy values to new row in current worksheet
    If Not duplicateFound Then
    newRow = wsCurrent.Cells(wsCurrent.Rows.Count, "B").End(xlUp).Row + 1 ' Next available row

    wsCurrent.Cells(newRow, "B").Value = wsRROB.Cells(i, "AE").Value
    wsCurrent.Cells(newRow, "C").Value = wsRROB.Cells(i, "U").Value
    wsCurrent.Cells(newRow, "D").Value = wsRROB.Cells(i, "C").Value
    wsCurrent.Cells(newRow, "E").Value = wsRROB.Cells(i, "X").Value
    wsCurrent.Cells(newRow, "F").Value = wsRROB.Cells(i, "F").Value
    wsCurrent.Cells(newRow, "G").Value = wsRROB.Cells(i, "B").Value
    End If

    NextRow:
    Next i

    ' Close selected file and clean up
    wbSelected.Close SaveChanges:=False
    Set wsRROB = Nothing
    Set wsCurrent = Nothing
    Set wbSelected = Nothing

    ' Display completion message
    MsgBox "File processed successfully!"
    End Sub

    Function IsInArray(ByVal value As Variant, arr As Variant) As Boolean
    Dim element As Variant
    For Each element In arr
    If element = value Then
    IsInArray = True
    Exit Function
    End If
    Next element
    IsInArray = False
    End Function

    The code should correctly handle the duplicate entries and only add them once to the worksheet.

     



    Please click Mark as Best Response & Like if my post helped you to solve your issue.
    This will help others to find the correct solution easily. It also closes the item.


    If the post was useful in other ways, please consider giving it Like.


    Kindest regards,


    Leon Pavesic

    • Chongsian's avatar
      Chongsian
      Copper Contributor

      Hi LeonPavesic,

       

      Thanks for your reply. I have added the duplicateFound that you recommended and the same 2 entries are still appearing in the new row creating duplicates. Somehow the macro doesn't recognize the row as duplicate despite it deemed as a duplicates in the values if using excel conditional formatting.

Resources