VBA for removing duplicates based on several criterias

[mangodango]

Hello, I am struggling iwth creating a macro, which will remove duplicates rows based on some criteria. Let's say I'd like macro to remove duplicates based on 2 columns B and V. The logic that:


1. If there are multiple rows with the same values in column B + the string value in col V is like 'Final Assessment*, I'd like macro to remove the duplicated rows.
2. If there are multiple rows with the same values in column B + and there is no 'Final Assessment' phase in col V. I'd like macro to still remove the duplicates, but to keep 1 row (ideally check if there is any other value in V and keep this one. If not the blank is also ok).




I was thinking about something like:

sub deldups


Dim src As Range


Application.ScreenUpdating = False


Set src = Worksheets("Model Report 20190227").Range("2:17783")




If (Worksheets("Model Report 20190227").Range("v2").Value Like "*Final Assessment*") Then
    Worksheets(""Model Report 20190227").CurrentRegion.RemoveDuplicates 


end if


Application.ScreenUpdating = True


end sub

But I am quite unsure about adding additional conditions. I'd update some sample worksheet later.


Many thanks for your insights.

 

[oldbrewer]

name	color
alan	red
bill	blue
dave	green
fred	red
alan	silver
bill	gold
dave	yellow
fred	red
alan	gold
bill	blue
dave	yellow
bill	blue
	so you want to remove rows 9, 11, 13 ?

<colgroup><col width="64" span="8" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[mangodango]

Hello, I meant rather something like:
B V
106106 Final assessment
106106 Initial assessment
106106 Final assessment - additional
101010
101010 Initial assessment
101010

After removing the dups will provide this output:
B V
106106 Final assessment
101010 Initial assessment

Many thanks

 

[DanteAmor]

Try with the folowing.
It requires sorting by columns B and V, assumes that the data starts in row 2 and in row 1 you have a header.

Sub removing_duplicates()
    Dim u As Double, i As Double
    
    Application.ScreenUpdating = False
    u = Range("B" & Rows.Count).End(xlUp).Row
    Range("A1").CurrentRegion.Sort key1:=Range("B1"), order1:=xlAscending, key2:=Range("V1"), order2:=xlAscending, Header:=xlYes
    
    For i = u To 2 Step -1
        If WorksheetFunction.CountIfs(Range("B2:B" & u), Cells(i, "B")) > 1 Then Rows(i).Delete
    Next
    Application.ScreenUpdating = True
    MsgBox "End"
    
End Sub

 

[Legacy 397974]

Try with the folowing.
It requires sorting by columns B and V, assumes that the data starts in row 2 and in row 1 you have a header.

Sub removing_duplicates()
    Dim u As Double, i As Double
    
    Application.ScreenUpdating = False
    u = Range("B" & Rows.Count).End(xlUp).Row
    Range("A1").CurrentRegion.Sort key1:=Range("B1"), order1:=xlAscending, key2:=Range("V1"), order2:=xlAscending, Header:=xlYes
    
    For i = u To 2 Step -1
        If WorksheetFunction.CountIfs(Range("B2:B" & u), Cells(i, "B")) > 1 Then Rows(i).Delete
    Next
    Application.ScreenUpdating = True
    MsgBox "End"
    
End Sub

Hello, I was trying to execute the code above and I receive following message: 'Run time error 1004: the sort reference is not valid. Make sure that's within the data you want to sort and the first sort by box isn't the same or blank.

 

[DanteAmor]

Hello, I was trying to execute the code above and I receive following message: 'Run time error 1004: the sort reference is not valid. Make sure that's within the data you want to sort and the first sort by box isn't the same or blank.

How are your data on the sheet? They should start at cell A1, at row 1 your headers and at row 2 down your data.

 

[mangodango]

I've checked that I had some blank, hidden columns in my worksheet. It's now working flawlessly, thank you so much for your help.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[mangodango]

Hi DanteAmor, I did a double check on your macro using worksheet with more data than yesterday and in fact sometimes, when I have for instance:
B V
106106
106106 Initial assessmnet

I receive the data:
B V
106106 blank

Do you know why is that?

Also I noticed that the range error sometimes occurs depending if not only I have headers and data in row 2, but if I have any blanks.

 

[DanteAmor]

Try with this

Sub removing_duplicates()
    Dim u As Double, i As Double
    
    Application.ScreenUpdating = False
    
    Range("V:V").Replace What:=" ", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    u = Range("B" & Rows.Count).End(xlUp).Row
    Range("A1:V" & u).Sort key1:=Range("B1"), order1:=xlAscending, key2:=Range("V1"), order2:=xlAscending, Header:=xlYes
    
    For i = u To 2 Step -1
        If WorksheetFunction.CountIfs(Range("B1:B" & u), Cells(i, "B")) > 1 Then Rows(i).Delete
    Next
    Application.ScreenUpdating = True
    MsgBox "End"
    
End Sub