how to remove duplicate amount (E) and keep (D) value remain sames

[kapoor2892]

how to remove duplicate amount (E) and keep (D) value remain sames

 

[Joe4]

Welcome to the Board!

Can you show us what your expected results should look like?
Do you want the values to then shift up, or leave blanks?

 

[kapoor2892]

Welcome to the Board!

Can you show us what your expected results should look like?
Do you want the values to then shift up, or leave blanks?

I want duplicate amount value to get removed. either blank or zero. example as below

 

[Joe4]

Will the duplicates always be next to each other, or could they be like this?

And could there be more than just 2, or could there also be more like this?

 

[kapoor2892]

Will the duplicates always be next to each other, or could they be like this?
View attachment 55682

Yes. duplicates are always next to each other.

 

[kapoor2892]

Will the duplicates always be next to each other, or could they be like this?
View attachment 55682

And could there be more than just 2, or could there also be more like this?
View attachment 55683

yes. could be more than 2 as well sometimes.

 

[Joe4]

OK, I think this code should do what you want:

Sub RemovesDuplicates()

    Dim lr As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column E with data
    lr = Cells(Rows.Count, "E").End(xlUp).Row
    
'   Loop through all rows backwards up to row 4
    For r = lr To 4 Step -1
'       Check to see if columns D and E match row above
        If (Cells(r, "D") = Cells(r - 1, "D")) And (Cells(r, "E") = Cells(r - 1, "E")) Then
'           Zero out value in column E
            Cells(r, "E") = 0
        End If
    Next r

    Application.ScreenUpdating = True

End Sub

 

[kapoor2892]

OK, I think this code should do what you want:

Sub RemovesDuplicates()

    Dim lr As Long
    Dim r As Long
   
    Application.ScreenUpdating = False
   
'   Find last row in column E with data
    lr = Cells(Rows.Count, "E").End(xlUp).Row
   
'   Loop through all rows backwards up to row 4
    For r = lr To 4 Step -1
'       Check to see if columns D and E match row above
        If (Cells(r, "D") = Cells(r - 1, "D")) And (Cells(r, "E") = Cells(r - 1, "E")) Then
'           Zero out value in column E
            Cells(r, "E") = 0
        End If
    Next r

    Application.ScreenUpdating = True

End Sub

It worked. Thanks much.

 

[Joe4]

You are welcome.