Sorting Spreadsheet with Duplicate Values Using VBA

I'm trying to create a macro that will check the values of Column A (Client ID number), identify duplicate values, then, once a duplicate value is found, perform a nested If/Then check that will return values into certain cells based on what it finds. If Column F (Program Description) of the row corresponding to the duplicate value contains the substring "UPGRADE", it should make the text of Column J of the row corresponding to the original value equal to the text of Column F in the duplicate value. Then, the duplicate row should be deleted, but I have not gotten that far yet.

Here's what I have so far-

Dim lastrow As Long

lastrow = Cells(Rows.Count, "A").End(xlUp).Row 'find last row in column A

For x = 1 To lastrow
If Cells(x, 1).Value <> ActiveCell.Value Then 'Check if cell in column A contains the same value as the activated cell

For y = 1 To lastrow
If Cells(y, 1).Value = Cells(x, 1).Value Then 'Compares cell against each value in column A. If there is a match, the do the following:

If Cells(y,6).Value <> "UPGRADE" Then 'Checks if duplicate value contains "UPGRADE"

Cells (x,10).Value= Cells(y,10).Value 'If this value is found, copy the value of the duplicate program name into a specified column for that program type in row x.

Else Cells(x,12).Value=Cells(y,12).Value 'If the value is not found, copy the program type into a separate column for that program type in row x.
End If
Next y
End If
Next x


I tried running this program and received a "Next without For" error, but I'm not sure how to resolve it, or if the code would work if I did. Any help would be greatly appreciated.

If

End If

End If

2 Answers
2

It is not perfectly clear what you want to do, but is the following working for you?

Public Sub checkDup()
Dim lastrow As Long, x As Long, y As Long

lastrow = Cells(rows.Count, "A").End(xlUp).Row 'find last row in column A
For x = 1 To lastrow
'If Cells(x, 1).Value <> ActiveCell.Value Then 'Check if cell in column A contains the same value as the activated cell
For y = x + 1 To lastrow
If Cells(y, 1).Value = Cells(x, 1).Value Then 'Compares cell against each value in column A. If there is a match, the do the following:
If Cells(y, 6).Value <> "UPGRADE" Then 'Checks if duplicate value contains "UPGRADE"
Cells(x, 10).Value = Cells(y, 6).Value 'If this value is found, copy the value of the duplicate program name into a specified column for that program type in row x.
'Else
'Cells(x, 12).Value = Cells(y, 12).Value 'If the value is not found, copy the program type into a separate column for that program type in row x.
End If
End If
Next y
'End If
Next x

End Sub


If Cells(y, 6).Value = "UPGRADE" And Not Cells(x, 6).Value = "UPGRADE" Then

The next without for is because of the if then count not matching the end if count
Here, indentation is really useful.

Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
'find last row in column A
For x = 1 To lastrow
If Cells(x, 1).Value <> ActiveCell.Value Then
'Check if cell in column A contains the same value as the activated cell
For y = 1 To lastrow
If Cells(y, 1).Value = Cells(x, 1).Value Then
'Compares cell against each value in column A. If there is a match, the do the following:
If Cells(y,6).Value <> "UPGRADE" Then
'Checks if duplicate value contains "UPGRADE"
Cells (x,10).Value= Cells(y,10).Value
'If this value is found, copy the value of the duplicate program name into a specified column for that program type in row x.
Else Cells(x,12).Value=Cells(y,12).Value
'If the value is not found, copy the program type into a separate column for that program type in row x.
End If
'I inserted another end if here
end if
Next y
End If
Next x


By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.