Remove Duplicates by Row

[Guzzlr]

Hello All
I have the below code which is working good t remove duplicates by columns. I'm having issues trying to modify it to remove duplicates by Row, instead of columns.
I tried simply removing the "Column" part, and replacing with "Row"...but that was a catastrophe.
Is it possible to modify the below code to remove duplicates by row instead of columns?
Thank you

Sub RemoveDuplicate()

Application.ScreenUpdating = True
Application.DisplayAlerts = False

  For i = 1 To Sheets("Matrix").Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
    Sheets("Matrix").Columns(i).RemoveDuplicates Columns:=1, Header:=xlYes
  Next


Application.ScreenUpdating = False
Application.DisplayAlerts = True

 

[Logit]

After running the last macros on my computer the following image is what I am left with.
Are you wanting Col E:G cleared of all data ? And, if so, If the entire columns are cleared is that going to cause an issue with data
on rows further down in those cols ?

 

[Peter_SSs]

I tried the numbers in column/Row:

G:4	H:4	I:4
1	1	1
2	2	2
3	3	3
1
2
3

To get a general code that will work with other ranges, we would need some way to determine where the range starts and ends, but for that particular example, try this.

Sub RemoveDupes()
  Dim d As Object
  Dim c As Range
  
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In Range("G4:I9")
    If Not IsEmpty(c.Value) Then d(c.Value) = Empty
  Next c
  Range("K4").Resize(d.Count).Value = Application.Transpose(d.Keys)
End Sub

Here is my sample data and results.

Guzzlr.xlsm
	G	H	I	J	K
4	1	1	1		1
5	2	2	2		2
6	3	3	3		3
7	1
8	2
9	3
Sheet1

 

[Guzzlr]

After running the last macros on my computer the following image is what I am left with.
Are you wanting Col E:G cleared of all data ? And, if so, If the entire columns are cleared is that going to cause an issue with data
on rows further down in those cols ?

This is good, and will not hurt data further down, as this will be used as a template only. However, when I run it, cell A1 always had a duplicate for some reason. What is the code you used?
Thanks for the help

 

[Logit]

This should do what you are seeking :

Sub AmalgamateCols()

    Dim Col As Long
    Application.ScreenUpdating = False
  
    For Col = 1 To 39     '<--- adjust number of columns here
        Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(2644).Value = _
            Range(Cells(1, Col), Cells(2648, Col)).Value
    Next Col
    With Range("A1", Range("A" & Rows.Count).End(xlUp))
        .Replace 0, ""
        .Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
    End With
    Application.ScreenUpdating = True
    DeleteDups
    
End Sub

Sub DeleteDups()
    
    Dim x               As Long
    Dim LastRow         As Long
    Dim Cells           As Range
    Application.ScreenUpdating = False
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastRow = LastRow
    End With
 
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
            Range("A" & x).Delete
        End If
    Next x
    Application.ScreenUpdating = True
    
    Range("E:E,F:F,G:G").ClearContents
End Sub

 

[Guzzlr]

This should do what you are seeking :

Sub AmalgamateCols()

    Dim Col As Long
    Application.ScreenUpdating = False
 
    For Col = 1 To 39     '<--- adjust number of columns here
        Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(2644).Value = _
            Range(Cells(1, Col), Cells(2648, Col)).Value
    Next Col
    With Range("A1", Range("A" & Rows.Count).End(xlUp))
        .Replace 0, ""
        .Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
    End With
    Application.ScreenUpdating = True
    DeleteDups
   
End Sub

Sub DeleteDups()
   
    Dim x               As Long
    Dim LastRow         As Long
    Dim Cells           As Range
    Application.ScreenUpdating = False
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastRow = LastRow
    End With
 
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
            Range("A" & x).Delete
        End If
    Next x
    Application.ScreenUpdating = True
   
    Range("E:E,F:F,G:G").ClearContents
End Sub

It Works!
Thank you

 

[Logit]

You are welcome.

 

[Peter_SSs]

It Works!
Thank you

Are you sure?

I just ran the codes with this sample data

Guzzlr.xlsm
	A	B	C
1	1	90	66
2	2	33	34
3	3	48	99
Sheet1 (3)

.. and this was the result

Guzzlr.xlsm
	A	B	C
1	1	90	66
2	2	33	34
3	3	48	99
4	9
5	33
6	34
7	48
8	66
9	99
Sheet1 (3)

You will note that the results include "9" which was not in the original data and omits 90 which was in the original data. (Ref the risky code line .Replace 0, "")

Other comments/questions

• What is this line for LastRow = LastRow ?
  
  
• Why does the sample code process 39 columns and remove 3 of them?
  
  
• Doesn't the shorter (and faster) code in post #12 produce the correct results? (It does not sort because the original expected results in post 3 were not sorted, but could easily do that if required)