Remove duplicate by selected

[Sefty]

Hello,
i need help, how to delete duplicates, and only select the last data. For example, if there are 3 data that are the same, then only the third data is taken
data that needs to be deleted per row, duplicates based on column B but need to delete all rows and only leave 1 last row.
Thanks

Book1
	A	B	C	D	E	F
1		Before
2		Hari	A	b	c
3		Sunday	a	a	b
4		Sunday	f	g	jj
5		Sunday	1	2	jj
6		Monday	4	5	7
7		Monday	9	0	1
8		Friday	1	2	5
9		Friday	1	4	6
10
11
12		After
13		Hari	A	b	c
14		Sunday	1	2	jj
15		Monday	9	0	1
16		Friday	1	4	6
17
Sheet1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B3:B9,B12	Cell Value	duplicates	text	NO
B14:B16	Cell Value	duplicates	text	NO

 

[Legacy 143009]

Like this?

Sub test()
  Dim lRow As Long
  lRow = Cells(Rows.Count, "B").End(xlUp).Row
  Application.ScreenUpdating = False
  For i = lRow To 2 Step -1
    If Cells(i - 1, "B").Value2 = Cells(i, "B").Value2 Then
      Rows(i - 1).EntireRow.Delete
      i = i + 1
    End If
  Next
  Application.ScreenUpdating = True
End Sub

 

[Sefty]

Like this?

Sub test()
  Dim lRow As Long
  lRow = Cells(Rows.Count, "B").End(xlUp).Row
  Application.ScreenUpdating = False
  For i = lRow To 2 Step -1
    If Cells(i - 1, "B").Value2 = Cells(i, "B").Value2 Then
      Rows(i - 1).EntireRow.Delete
      i = i + 1
    End If
  Next
  Application.ScreenUpdating = True
End Sub

Wow

Like this?

Sub test()
  Dim lRow As Long
  lRow = Cells(Rows.Count, "B").End(xlUp).Row
  Application.ScreenUpdating = False
  For i = lRow To 2 Step -1
    If Cells(i - 1, "B").Value2 = Cells(i, "B").Value2 Then
      Rows(i - 1).EntireRow.Delete
      i = i + 1
    End If
  Next
  Application.ScreenUpdating = True
End Sub

I'm sorry, if i want remove duplicate and selected highest "class" on the column "D" what to do
Thank you

Book1
	A	B	C	D	E	F
1		Day	Kategori 1	Class	Kategori 2
2		Sunday	8	9	0
3	delete	Sunday	3	4	1
4	delete	Sunday	3	4	1
5		Monday	1	4	8
6	delete	Monday	2	1	9
7	delete	Monday	3	2	1
8	delete	Friday	7	2	2
9		Friday	5	3	4
10
11
12
13
Sheet1

 

[Peter_SSs]

@Flashbond
FWIW

• '.EntireRow' is not required since Rows(i - 1) already is an entire row
• 'i = i + 1' is not required

  For i = lRow To 2 Step -1
    If Cells(i - 1, "B").Value2 = Cells(i, "B").Value2 Then
      Rows(i - 1).EntireRow.Delete
      i = i + 1
    End If
  Next

@Sefty
About how many rows is your real data set likely to be?

 

[Sefty]

@Flashbond
FWIW

• '.EntireRow' is not required since Rows(i - 1) already is an entire row
• 'i = i + 1' is not required

  For i = lRow To 2 Step -1
    If Cells(i - 1, "B").Value2 = Cells(i, "B").Value2 Then
      Rows(i - 1).EntireRow.Delete
      i = i + 1
    End If
  Next

@Sefty
About how many rows is your real data set likely to be?

There are 6000 data i have

sorry if i want remove duplicate and selected highest "class" on the column "D" what to do

Book1
	A	B	C	D	E	F
1		Day	Kategori 1	Class	Kategori 2
2		Sunday	8	9	0
3	delete	Sunday	3	4	1
4	delete	Sunday	3	4	1
5		Monday	1	4	8
6	delete	Monday	2	1	9
7	delete	Monday	3	2	1
8	delete	Friday	7	2	2
9		Friday	5	3	4
10
11
12
13
Sheet1

 

[Legacy 143009]

Then something like this:

Sub test()
  Dim lRow As Long
  lRow = Cells(Rows.Count, "B").End(xlUp).Row
  Application.ScreenUpdating = False
  For i = lRow To 2 Step -1
    If Cells(i - 1, "B").Value2 = Cells(i, "B").Value2 Then
      If Cells(i - 1, "D").Value2 <= Cells(i, "D").Value2 Then
        Rows(i - 1).Delete
      Else
        Rows(i).Delete
      End If
    End If
  Next
  Application.ScreenUpdating = True
End Sub

 

[Legacy 143009]

@Flashbond
FWIW

• '.EntireRow' is not required since Rows(i - 1) already is an entire row
• 'i = i + 1' is not required

  For i = lRow To 2 Step -1
    If Cells(i - 1, "B").Value2 = Cells(i, "B").Value2 Then
      Rows(i - 1).EntireRow.Delete
      i = i + 1
    End If
  Next

@Sefty
About how many rows is your real data set likely to be?

OMG,

I didn't know that I can delete the entire row without specifying it if it was a row..
I don't know why I went with i = i + 1. I think I was afraid of skipping a row.

 

[Sefty]

Then something like this:

Sub test()
  Dim lRow As Long
  lRow = Cells(Rows.Count, "B").End(xlUp).Row
  Application.ScreenUpdating = False
  For i = lRow To 2 Step -1
    If Cells(i - 1, "B").Value2 = Cells(i, "B").Value2 Then
      If Cells(i - 1, "D").Value2 <= Cells(i, "D").Value2 Then
        Rows(i - 1).Delete
      Else
        Rows(i).Delete
      End If
    End If
  Next
  Application.ScreenUpdating = True
End Sub

WOW its works, thanks

 

[Legacy 143009]

WOW its works, thanks

I am happy that it did work. Please keep an eye on this thread. @Peter_SSs may come up with a faster solution

 

[Peter_SSs]

Please keep an eye on this thread. @Peter_SSs may come up with a faster solution

I think that it could be done faster, but I'm not sure with 6,000 rows (not really very big) that the difference would be noticeable.

One other comment about your codes: I note that you have declared lRow as long but left i undeclared (& therefore Variant). I would recommend declaring all variables (& forcing yourself to do so with the 'Require Variable Declaration' setting in the vba Options).

@Sefty
Is the supplied code fast enough? In other words, is there any noticeable wait-time while the code runs?