clear duplicated items in specific columns and arrange below for each item based on column

[Mussa]

hi
I search for macro to clear repeated items in COL A and arrange again below for each item .



sheet data

ttt.xlsm
	A	B	C	D	E	F
1	DEL NO	BATCH NO	TTL	TT1	IMPORT	EXPORT
2	CCD-1	CC-1	SS-1	TRU	12	10
3	CCD-1	CC-1	SS-1	LTR	12	5
4	CCD-1	CC-2	SS-2	FG	5	5
5	CCS-2	CC-1	SS-1	TRR	10	5
6	CCS-2	CC-1	SS-1	LTR	20	10
7	CSD-1	CS-1	LL-1	RRL	15	5
8	CSD-1	CS-2	LL-2	TTY	10	10
9	CCD-1	CS-3	LL-3	MMW	20	10
10	CCL	CS-4	LL-4	NNW	10	10
11	CCL	CC-2	SS-2	LTR	21	5
12	CCM	CC-3	SS-3	LTR	22	5
13	CSD-1	CS-1	LL-1	RRL	15	5
DATA

expected result
sheet result

ttt.xlsm
	A	B	C	D	E	F
1	DEL NO	BATCH NO	TTL	TT1	IMPORT	EXPORT
2	CCD-1	CC-1	SS-1	TRU	12	10
3		CC-1	SS-1	LTR	12	5
4		CC-2	SS-2	FG	5	5
5		CS-3	LL-3	MMW	20	10
6	CCS-2	CC-1	SS-1	TRR	10	5
7		CC-1	SS-1	LTR	20	10
8	CSD-1	CS-1	LL-1	RRL	15	5
9		CS-2	LL-2	TTY	10	10
10		CS-1	LL-1	RRL	15	5
11	CCL	CS-4	LL-4	NNW	10	10
12		CC-2	SS-2	LTR	21	5
13	CCM	CC-3	SS-3	LTR	22	5
RESULT

 

[Peter_SSs]

This does not put the groups in the same order as your expected results, but would this suffice?
Note that this also replaces the original data. I wasn't sure if your two mini-sheets were just to show the original and the result or whether you actually want the results on a different sheet.

Test with a copy of your workbook

Sub Mussa()
  With Range("A1").CurrentRegion
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
    With .Columns(1).Offset(1).Resize(.Rows.Count - 1)
      .Value = Evaluate(Replace(Replace("if(#=%,True,#)", "#", .Address), "%", .Offset(-1).Address))
      On Error Resume Next
      .SpecialCells(xlConstants, xlLogical).ClearContents
      On Error GoTo 0
    End With
  End With
End Sub

With your original sample data, this is the result for me.

Mussa_1.xlsm
	A	B	C	D	E	F
1	DEL NO	BATCH NO	TTL	TT1	IMPORT	EXPORT
2	CCD-1	CC-1	SS-1	TRU	12	10
3		CC-1	SS-1	LTR	12	5
4		CC-2	SS-2	FG	5	5
5		CS-3	LL-3	MMW	20	10
6	CCL	CS-4	LL-4	NNW	10	10
7		CC-2	SS-2	LTR	21	5
8	CCM	CC-3	SS-3	LTR	22	5
9	CCS-2	CC-1	SS-1	TRR	10	5
10		CC-1	SS-1	LTR	20	10
11	CSD-1	CS-1	LL-1	RRL	15	5
12		CS-2	LL-2	TTY	10	10
13		CS-1	LL-1	RRL	15	5
Sheet1

 

[Mussa]

awsome !

but would this suffice?

yes
but I have two thing . may you make the result in sheet2 instead of the same sheet ?
and explain your code by writing the comments inside it,please ?

 

[Peter_SSs]

may you make the result in sheet2 instead of the same sheet

Does sheet2 already exist in the workbook?

If so, what should happen to any existing data that is already in sheet2?

 

[Mussa]

it should replace the data . it' s like updating. if there are the same items then should updating based on sheet1 and if there is a new item then should copy to the bottom

 

[veyselemre]

Alternative for result without sorting,

Sub test()
    Dim s1 As Worksheet, s2 As Worksheet, _
        data(), yData(), i&, ky$, itms(), itm, _
        bl, say&, ii&
    Set s1 = Sheets("DATA")
    Set s2 = Sheets("RESULT")
    data = s1.Range("A2:F" & s1.Cells(Rows.Count, 1).End(3).Row).Value
    ReDim yData(1 To UBound(data), 1 To UBound(data, 2))
    With CreateObject("Scripting.Dictionary")
        For i = LBound(data) To UBound(data)
            ky = data(i, 1)
            If Not .exists(ky) Then
                .Item(ky) = i
            Else
                .Item(ky) = .Item(ky) & "," & i
            End If
        Next i
        itms = .items
        For Each itm In itms
            bl = Split(itm, ",")
            For i = 0 To UBound(bl)
                say = say + 1
                For ii = 2 To 6
                    yData(say, ii) = data(bl(i), ii)
                Next ii
                If i = 0 Then yData(say, 1) = data(bl(i), 1)
            Next i
        Next
    End With
    s2.Cells.ClearContents
    s1.Range("A1").Resize(, 6).Copy s2.Range("A1")
    s2.Range("A2").Resize(say, UBound(data, 2)).Value = yData

End Sub

 

[Peter_SSs]

it should replace the data . ........ and if there is a new item then should copy to the bottom

That seems contradictory to me. It either replaces the data that is already on Sheet2 or it appends the data to the bottom of what is already on Sheet2?

 

[Mussa]

That seems contradictory to me. It either replaces the data that is already on Sheet2 or it appends the data to the bottom of what is already on Sheet2?

sorry. actually ther is no data in sheet2 . I'm talking about when run macro from the first time . it just replaces the data when run macro repeatedly

 

[Peter_SSs]

OK, try this

Sub Mussa_v2()
  With Sheets("Sheet2")
    'Clear any existing data
    .UsedRange.Clear
    'Copy the table from Sh1 to Sh2
    Sheets("Sheet1").Range("A1").CurrentRegion.Copy .Range("A1")
    With .Range("A1").CurrentRegion
      'Sort based on column A to get all the groups together
      .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
      With .Columns(1).Offset(1).Resize(.Rows.Count - 1)
        'Look at the column A cells from row 2 down and replace with True if they are the same as the cell above
        .Value = Evaluate(Replace(Replace("if(#=%,True,#)", "#", .Address), "%", .Offset(-1).Address))
        'Clear contents from all cells that contain True
        On Error Resume Next
        .SpecialCells(xlConstants, xlLogical).ClearContents
        On Error GoTo 0
      End With
    End With
  End With
End Sub

 

[Mussa]

@Peter_SSs when I add repeated items or new items in sheet1 the code doesn't work well . but when I delete the data in sheet2 and run the macro again it works well . how I can fix it this problem without I have to delete data in sheet2 when I add the data in sheet1 whether repeated items or a new.
sheet1

ttt.xlsm
	A	B	C	D	E	F
1	DEL NO	BATCH NO	TTL	TT1	IMPORT	EXPORT
2	CCD-1	CC-1	SS-1	TRU	12	10
3	CCD-1	CC-1	SS-1	LTR	12	5
4	CCD-1	CC-2	SS-2	FG	5	5
5	CCS-2	CC-1	SS-1	TRR	10	5
6	CCS-2	CC-1	SS-1	LTR	20	10
7	CSD-1	CS-1	LL-1	RRL	15	5
8	CSD-1	CS-2	LL-2	TTY	10	10
9	CCD-1	CS-3	LL-3	MMW	20	10
10	CCL	CS-4	LL-4	NNW	10	10
11	CCL	CC-2	SS-2	LTR	21	5
12	CCM	CC-3	SS-3	LTR	22	5
13	CSD-1	CS-1	LL-1	RRL	15	5
14	CSD-2	CS-2	LL-2	RRL	15	5
15	CSD-3	CS-3	LL-3	RRL	15	5
16	CSD-4	CS-4	LL-4	RRL	15	5
17	CSD-5	CS-5	LL-5	RRL	15	5
18	CSD-1	CS-1	LL-1	RRL	15	5
19	CSD-2	CS-2	LL-2	RRL	15	5
20	CSD-3	CS-3	LL-3	RRL	15	5
21	CSD-4	CS-4	LL-4	RRL	15	5
22	CSD-5	CS-5	LL-5	RRL	15	5
sheet1

this is what I got

ttt.xlsm
	A	B	C	D	E	F
1	DEL NO	BATCH NO	TTL	TT1	IMPORT	EXPORT
2	CCD-1	CC-1	SS-1	TRU	12	10
3		CC-1	SS-1	LTR	12	5
4		CC-2	SS-2	FG	5	5
5	CCS-2	CS-3	LL-3	MMW	20	10
6		CS-4	LL-4	NNW	10	10
7	CSD-1	CC-2	SS-2	LTR	21	5
8		CC-3	SS-3	LTR	22	5
9	CCD-1	CC-1	SS-1	TRR	10	5
10	CCL	CC-1	SS-1	LTR	20	10
11		CS-1	LL-1	RRL	15	5
12	CCM	CS-2	LL-2	TTY	10	10
13	CSD-1	CS-1	LL-1	RRL	15	5
14	CSD-2	CS-1	LL-1	RRL	15	5
15	CSD-3	CS-2	LL-2	RRL	15	5
16	CSD-4	CS-2	LL-2	RRL	15	5
17	CSD-5	CS-3	LL-3	RRL	15	5
18	CSD-1	CS-3	LL-3	RRL	15	5
19	CSD-2	CS-4	LL-4	RRL	15	5
20	CSD-3	CS-4	LL-4	RRL	15	5
21	CSD-4	CS-5	LL-5	RRL	15	5
22	CSD-5	CS-5	LL-5	RRL	15	5
sheet2