delete old duplicate items by sorting not loop

[Hasson]

Hello
I want delete the old data . should keep the last duplicate items (should be by sorting not loop if it's possible) based on column C .

(6).xlsx
	A	B	C	D
1	ITEM	CODE	ID	QTY
2	1	BS-TA-113	QQW-14 L/R CLA14 SS230 EG DF/100	12
3	2	BS-TA-117	QQW-181 RRSDF BRI	234
4	3	BS-TA-113	QQW-14 L/R CLA14 SS230 EG DF/100	400
5	4	BS-TA-119	QQW-20 KV/1**2 CLA20 CV	123
6	5	BS-TA-107	QQW-8 CLA8 UKI	456
7	6	BS-TA-113	QQW-14 L/R CLA14 SS230 EG DF/100	600
SHEET1

result

(6).xlsx
	A	B	C	D
1	ITEM	CODE	ID	QTY
2	2	BS-TA-117	QQW-181 RRSDF BRI	234
3	4	BS-TA-119	QQW-20 KV/1**2 CLA20 CV	123
4	5	BS-TA-107	QQW-8 CLA8 UKI	456
5	6	BS-TA-113	QQW-14 L/R CLA14 SS230 EG DF/100	600
REPORT

my real data are 4000 rows
thanks

 

[Zot]

Specific reason why sorting is preferred in your requirement?

 

[Hasson]

Hi Zot ,
as I said

my real data are 4000 rows

as I know sorting makes the code faster especially for huge data that's why I wnat by sorting.

by the way the sorting is choice , the loop not bad ,but I search for the best code .

 

[Zot]

Try this

Sub Test()

Dim n As Long, eRow As Long
Dim rngUnion As Range
Dim ws1 As Worksheet, wsReport As Worksheet
Dim dData As Object

Application.ScreenUpdating = False

Set dData = CreateObject("Scripting.Dictionary")

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set wsReport = ActiveWorkbook.Sheets("Report")

eRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row

For n = eRow To 2 Step -1
    If Not dData.Exists(ws1.Range("C" & n).Value) Then
        dData.Add ws1.Range("C" & n).Value, Nothing
    Else
        If Not rngUnion Is Nothing Then
            Set rngUnion = Union(ws1.Range("C" & n), rngUnion)
        Else
            Set rngUnion = ws1.Range("C" & n)
        End If
    End If
Next

rngUnion.EntireRow.Delete

End Sub

 

[Hasson]

thanks .
if I make the sheet Report is active will delete duplicates from sheet1 without show any thing in sheet Report
and if if I make the sheet1 is active delete duplicates from sheet1 without show any thing in sheet Report and gives error
what 's my mistake?

 

[Zot]

thanks .
if I make the sheet Report is active will delete duplicates from sheet1 without show any thing in sheet Report
and if if I make the sheet1 is active delete duplicates from sheet1 without show any thing in sheet Report and gives error
what 's my mistake?

My fault. I was rushing home. I was deleting the SHeet1 even though I define sheet Report. I thought you can manage

Here the modified code

Sub Test()

Dim n As Long, eRow As Long
Dim rngUnion As Range
Dim ws1 As Worksheet, wsReport As Worksheet
Dim dData As Object

Application.ScreenUpdating = False

Set dData = CreateObject("Scripting.Dictionary")

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set wsReport = ActiveWorkbook.Sheets("Report")

ws1.Cells.Copy wsReport.Range("A1")

eRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row

For n = eRow To 2 Step -1
    If Not dData.Exists(wsReport.Range("C" & n).Value) Then
        dData.Add wsReport.Range("C" & n).Value, Nothing
    Else
        If Not rngUnion Is Nothing Then
            Set rngUnion = Union(wsReport.Range("C" & n), rngUnion)
        Else
            Set rngUnion = wsReport.Range("C" & n)
        End If
    End If
Next

rngUnion.EntireRow.Delete

End Sub

 

[Hasson]

it's very awesome !!!
just last thing can I rearrange numbers sequences in column A for each item after delete in sheet report like 1,2,3....

 

[Zot]

it's very awesome !!!
just last thing can I rearrange numbers sequences in column A for each item after delete in sheet report like 1,2,3....

You can use AutoFill

Sub Test()

Dim n As Long, eRow As Long
Dim rngUnion As Range
Dim ws1 As Worksheet, wsReport As Worksheet
Dim dData As Object

Application.ScreenUpdating = False

Set dData = CreateObject("Scripting.Dictionary")

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set wsReport = ActiveWorkbook.Sheets("Report")

ws1.Cells.Copy wsReport.Range("A1")

eRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row

For n = eRow To 2 Step -1
    If Not dData.Exists(wsReport.Range("C" & n).Value) Then
        dData.Add wsReport.Range("C" & n).Value, Nothing
    Else
        If Not rngUnion Is Nothing Then
            Set rngUnion = Union(wsReport.Range("C" & n), rngUnion)
        Else
            Set rngUnion = wsReport.Range("C" & n)
        End If
    End If
Next

rngUnion.EntireRow.Delete

eRow = wsReport.Cells(Rows.Count, "A").End(xlUp).Row
wsReport.Range("A2") = 1
wsReport.Range("A3") = 2
wsReport.Range("A2:A3").AutoFill wsReport.Range("A2", "A" & eRow), 0

End Sub

 

[lrobbo314]

Another way using Power Query.

Book1 (version 1).xlsm
	A	B	C	D
1	ITEM	CODE	ID	QTY
2	1	BS-TA-113	QQW-14 L/R CLA14 SS230 EG DF/100	12
3	2	BS-TA-117	QQW-181 RRSDF BRI	234
4	3	BS-TA-113	QQW-14 L/R CLA14 SS230 EG DF/100	400
5	4	BS-TA-119	QQW-20 KV/1**2 CLA20 CV	123
6	5	BS-TA-107	QQW-8 CLA8 UKI	456
7	6	BS-TA-113	QQW-14 L/R CLA14 SS230 EG DF/100	600
8
9
10	ITEM	CODE	ID	QTY
11	2	BS-TA-117	QQW-181 RRSDF BRI	234
12	4	BS-TA-119	QQW-20 KV/1**2 CLA20 CV	123
13	5	BS-TA-107	QQW-8 CLA8 UKI	456
14	6	BS-TA-113	QQW-14 L/R CLA14 SS230 EG DF/100	600
Sheet6

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Group = Table.Group(Source, {"CODE"}, {{"Count", each Table.LastN(_,1), type table [ITEM=number, CODE=text, ID=text, QTY=number]}}),
    Expand = Table.ExpandTableColumn(Group, "Count", {"ITEM", "ID", "QTY"}, {"ITEM", "ID", "QTY"}),
    Reorder = Table.ReorderColumns(Expand,{"ITEM", "CODE", "ID", "QTY"}),
    Sort = Table.Sort(Reorder,{{"ITEM", Order.Ascending}})
in
    Sort

 

[Hasson]

@Zot this is perfect ! if you don't mind just I want adding some array into code to make fast for huge data in the future
thanks again .