help to adjusting code clear repeated items into column across sheets

[Mussa]

hello
previous thread I got help and code from this thread
clear duplicated items in specific columns and arrange below for each item based on column

Sub Mussa_v2[B]a[/B]()
  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[B](External:=True)[/B]), "%", .Offset(-1).Address[B](External:=True)[/B]))
        '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

now I want clear repeated items from column A for first sheet and clear repeated items from column B for second , third sheet

CLEAR.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
sh1

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

CLEAR.xlsm
	A	B	C	D
1	ITEM	DEL NO	BATCH NO	IMPORT
2	1	CCS-2	CC-1 SS-1 TRR	10
3	2	CCD-1	CC-1 SS-1 TRU	12
4	3	CCD-1	CC-2 SS-2 FG	5
5	4	CCD-2	CC-2 SS-2 FG	6
6	5	CCD-2	CC-2 SS-2 FG	7
sdf

result

CLEAR.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	CC-1	SS-1	TRR	10	5
6		CC-1	SS-1	LTR	20	10
7	CSD-1	CS-1	LL-1	RRL	15	5
8		CS-2	LL-2	TTY	10	10
9		CS-3	LL-3	MMW	20	10
10	CCL	CS-4	LL-4	NNW	10	10
11		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
sh1

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

CLEAR.xlsm
	A	B	C	D
1	ITEM	DEL NO	BATCH NO	IMPORT
2	1	CCS-2	CC-1 SS-1 TRR	10
3	2	CCD-1	CC-1 SS-1 TRU	12
4	3		CC-2 SS-2 FG	5
5	4	CCD-2	CC-2 SS-2 FG	6
6	5		CC-2 SS-2 FG	7
sdf

if it's not possible to mod the code I accept alternative

 

[DacEasy]

Hi I made a new private subroutine that you can Call from your existing code. Just put the Call above End Sub in your current code. Call forRemovingConsecutiveDuplicates

Private Sub forRemovingConsecutiveDuplicates()
Application.DisplayAlerts = False

    'Call this subroutine above End Sub in your current code - Call forRemovingConsecutiveDuplicates

    Dim lastRow As Long: Dim i As Long
    
    Sheets("Sheet1").Select 'Pick the right sheet
    'Find the lastRow
    With ActiveSheet
        lastRow = .UsedRange.Rows.Count + .UsedRange.Row - 1
    End With
        
    For i = lastRow To 2 Step -1 'Start at the bottom and work towards the top to clear duplicates
        If Range("A" & i) = Range("A" & i - 1) Then
            Range("A" & i).Value = ""
        End If
    Next i
    
    
    Sheets("Sheet2").Select 'Pick the right sheet
    'Find the lastRow
    With ActiveSheet
        lastRow = .UsedRange.Rows.Count + .UsedRange.Row - 1
    End With
        
    For i = lastRow To 2 Step -1 'Start at the bottom and work towards the top to clear duplicates
        If Range("B" & i) = Range("B" & i - 1) Then
            Range("B" & i).Value = ""
        End If
    Next i
    
    
    Sheets("Sheet3").Select 'Pick the right sheet
    'Find the lastRow
    With ActiveSheet
        lastRow = .UsedRange.Rows.Count + .UsedRange.Row - 1
    End With
        
    For i = lastRow To 2 Step -1 'Start at the bottom and work towards the top to clear duplicates
        If Range("B" & i) = Range("B" & i - 1) Then
            Range("B" & i).Value = ""
        End If
    Next i
    
Application.DisplayAlerts = True
End Sub

 

[Mussa]

thanks for your trying . your code just work for the third sheet

 

[DacEasy]

What are the Sheet names? I used Sheet1, Sheet2, and Sheet3, you may need to update the names.

 

[Mussa]

yes I renamed the sheets based on your code .

 

[DacEasy]

Interesting, I only test Sheet1 but you said only Sheet3 worked for you. The only thing different about the code is the columns. Column A for Sheet1, Column B for Sheet2 and 3. I would need to see like a screenshot of the code, something wasn't copied or pasted right maybe. You might be about to figure it out, if sheet 3 works, copy and paste and update the sheetname and column to check for duplicates.

 

[Mussa]

my bad ! I copy and paste just in sheet3 module . that's why the result just implement for sheet3.

it works, but I also made mistake about the lastrow in sheet1,2 in lastrow there is duplicate item should also delete it .

 

[DacEasy]

Glad you were able to get it working. I noticed the last row in the result for 1 and 2 was it was there, so I made code generate the exact same results. I will paste a piece of code you can place in the three sections to clean all duplicates.

 

[DacEasy]

Ok, this should remove all Duplicates. Each sheet has a section .

Option Explicit
Private Sub forRemovingConsecutiveDuplicates()
Application.DisplayAlerts = False

    'Call this subroutine above End Sub in your current code - Call forRemovingConsecutiveDuplicates

    Dim lastRow As Long: Dim i As Long: Dim j As Long
    
    Sheets("Sheet1").Select  'Picks the right sheet
    With ActiveSheet  'Find the lastRow
        lastRow = .UsedRange.Rows.Count + .UsedRange.Row - 1
    End With
        
    For i = 2 To lastRow
        For j = 3 To lastRow
            If i = j Then  'Make sure the cell doesn't compare itself
                j = j + 1  'or it will become blank
            End If
            
            If Range("A" & i) = Range("A" & j) Then 'Flows top to bottom and
                Range("A" & j).Value = ""           'blanks the duplicate
            End If
        Next j
    Next i
    
        
    Sheets("Sheet2").Select 'Picks the right sheet
    With ActiveSheet 'Find the lastRow
        lastRow = .UsedRange.Rows.Count + .UsedRange.Row - 1
    End With
        
    For i = 2 To lastRow
        For j = 3 To lastRow
            If i = j Then
                j = j + 1
            End If
            
            If Range("B" & i) = Range("B" & j) Then
                Range("B" & j).Value = ""
            End If
        Next j
    Next i
    
        
    Sheets("Sheet3").Select 'Picks the right sheet
    With ActiveSheet 'Find the lastRow
        lastRow = .UsedRange.Rows.Count + .UsedRange.Row - 1
    End With
        
    For i = 2 To lastRow
        For j = 3 To lastRow
            If i = j Then
                j = j + 1
            End If
            
            If Range("B" & i) = Range("B" & j) Then
                Range("B" & j).Value = ""
            End If
        Next j
    Next i
    
    Sheets("Sheet1").Select 'Goes back to the 1st sheet
    
Application.DisplayAlerts = True
End Sub

 

[Mussa]

much appreciated for your help .