vba Remove duplicates but keep one

[gtd526]

Hello,
Looking to remove dupes (row 3) in several columns (B:AUI) but keeping the first one listed.
Thank you.

NBA.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	VISITOR	Philadelphia	LA Lakers	Orlando	Washington	Houston	New Orleans	Chicago	Cleveland	New York	Oklahoma City	Charlotte	Denver	Dallas	Portland	Milwaukee	LA Clippers	New Orleans	San Antonio	Chicago
2	HOME	Boston	Golden State	Detroit	Indiana	Atlanta	Brooklyn	Miami	Toronto	Memphis	Minnesota	San Antonio	Utah	Phoenix	Sacramento	Philadelphia	LA Lakers	Charlotte	Indiana	Washington
3	DATE	10/18/22	10/18/22	10/19/22	10/19/22	10/19/22	10/19/22	10/19/22	10/19/22	10/19/22	10/19/22	10/19/22	10/19/22	10/19/22	10/19/22	10/20/22	10/20/22	10/21/22	10/21/22	10/21/22
2022-2023

 

[Peter_SSs]

Is this what you mean? Test with a copy of your data.

Sub Remove_Dupes()
  Dim c As Long
  
  Application.ScreenUpdating = False
  For c = Cells(3, Columns.Count).End(xlToLeft).Column To 3 Step -1
    If Cells(3, c).Value = Cells(3, c - 1).Value Then Columns(c).Delete
  Next c
  Application.ScreenUpdating = True
End Sub

 

[Trebor76]

Here's what I thought you wanted i.e. clear the contents if there's a duplicate:

Option Explicit
Sub Macro1()

    Dim cln As New Collection
    Dim i As Long
    Dim wsSrc As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("2022-2023")
    
    On Error Resume Next
        For i = 2 To wsSrc.Cells(3, Columns.Count).End(xlToLeft).Column
            cln.Add CStr(wsSrc.Cells(3, i)), wsSrc.Cells(3, i)
            If Err.Number <> 0 Then
                wsSrc.Cells(3, i).ClearContents
            End If
            Err.Clear
        Next i
    On Error GoTo 0
    
    Application.ScreenUpdating = True

End Sub

 

[gtd526]

Is this what you mean? Test with a copy of your data.

Sub Remove_Dupes()
  Dim c As Long
 
  Application.ScreenUpdating = False
  For c = Cells(3, Columns.Count).End(xlToLeft).Column To 3 Step -1
    If Cells(3, c).Value = Cells(3, c - 1).Value Then Columns(c).Delete
  Next c
  Application.ScreenUpdating = True
End Sub

its deleting the entire column. can it only clear.contents of the cell?
below is how I would like it to look.

2022-23-NBA-Schedule.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
6	VISITOR	Philadelphia	LA Lakers	Orlando	Washington	Houston	New Orleans	Chicago	Cleveland	New York	Oklahoma City	Charlotte	Denver	Dallas	Portland	Milwaukee	LA Clippers	New Orleans	San Antonio	Chicago
7	HOME	Boston	Golden State	Detroit	Indiana	Atlanta	Brooklyn	Miami	Toronto	Memphis	Minnesota	San Antonio	Utah	Phoenix	Sacramento	Philadelphia	L.A. Lakers	Charlotte	Indiana	Washington
8	DATE	10/18/22		10/19/22												10/20/22		10/21/22
Sheet1

 

[Trebor76]

its deleting the entire column. can it only clear.contents of the cell?
below is how I would like it to look.

Try my code

 

[gtd526]

Try my code

its deleting all dates

 

[Trebor76]

If the dates are actually dates and not strings that look like dates this worked for me:

Option Explicit
Sub Macro2()

    Dim cln As New Collection
    Dim i As Long
    Dim wsSrc As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("2022-2023")
    
    On Error Resume Next
        For i = 2 To wsSrc.Cells(3, Columns.Count).End(xlToLeft).Column
            If Len(wsSrc.Cells(3, i)) > 0 Then
                cln.Add CStr(Format(DateValue(wsSrc.Cells(3, i)), "DD-MMM-YYYY")), Format(DateValue(wsSrc.Cells(3, i)), "DD-MMM-YYYY")
                If Err.Number <> 0 Then
                    wsSrc.Cells(3, i).ClearContents
                End If
                Err.Clear
            End If
        Next i
    On Error GoTo 0
    
    Application.ScreenUpdating = True

End Sub

 

[gtd526]

If the dates are actually dates and not strings that look like dates this worked for me:

Option Explicit
Sub Macro2()

    Dim cln As New Collection
    Dim i As Long
    Dim wsSrc As Worksheet
   
    Application.ScreenUpdating = False
   
    Set wsSrc = ThisWorkbook.Sheets("2022-2023")
   
    On Error Resume Next
        For i = 2 To wsSrc.Cells(3, Columns.Count).End(xlToLeft).Column
            If Len(wsSrc.Cells(3, i)) > 0 Then
                cln.Add CStr(Format(DateValue(wsSrc.Cells(3, i)), "DD-MMM-YYYY")), Format(DateValue(wsSrc.Cells(3, i)), "DD-MMM-YYYY")
                If Err.Number <> 0 Then
                    wsSrc.Cells(3, i).ClearContents
                End If
                Err.Clear
            End If
        Next i
    On Error GoTo 0
   
    Application.ScreenUpdating = True

End Sub

Perfect. Thank you.

 

[Peter_SSs]

its deleting the entire column.

Yes, that's more what Excel "Remove Duplicates" does with rows so I did think that is what you wanted.
In future, giving the expected results as well as the original data would be a good idea to help clarify what you are after.

can it only clear.contents of the cell?

This is how I would do it.

Sub Remove_Dupes_v2()
  Dim c As Long
  
  Application.ScreenUpdating = False
  For c = Cells(3, Columns.Count).End(xlToLeft).Column To 3 Step -1
    If Cells(3, c).Value = Cells(3, c - 1).Value Then Cells(3, c).ClearContents
  Next c
  Application.ScreenUpdating = True
End Sub

 

[gtd526]

Yes, that's more what Excel "Remove Duplicates" does with rows so I did think that is what you wanted.
In future, giving the expected results as well as the original data would be a good idea to help clarify what you are after.


This is how I would do it.

Sub Remove_Dupes_v2()
  Dim c As Long
 
  Application.ScreenUpdating = False
  For c = Cells(3, Columns.Count).End(xlToLeft).Column To 3 Step -1
    If Cells(3, c).Value = Cells(3, c - 1).Value Then Cells(3, c).ClearContents
  Next c
  Application.ScreenUpdating = True
End Sub

Perfect. Thank you.