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
