Deleting columns if duplicate data found in a few

IREALLYambatman

Board Regular
Joined
Aug 31, 2016
Messages
58
Goal: If a duplicate value is found in a row, then delete the second the column associated with the duplicate value
My problem: My code seems to work for the most part, except it only deletes the FIRST duplicate values that it finds, not all duplicate values. And if you run it again it seems to delete stuff almost at random?
Example Data:
1
2
2
2
3
3
4
5
6
7
A
B
C
D
E
F
G
H
I
J

<tbody>
</tbody>
What I would like it to look like after:
1
2
3
4
5
6
7
A
B
E
G
H
I
J

<tbody>
</tbody>

My Code:
Code:
Sub DelDuplicateDataColumns()

Dim rng As Range
Dim rngCell As Variant
Set rng = Range("C2:KZ2") ' area to check '

For Each rngCell In rng.Cells
    vVal = rngCell.Text
    If (WorksheetFunction.CountIf(rng, vVal) = 1) Then
    Else
        rngCell.EntireColumn.Delete
    End If
Next rngCell

End Sub
 

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,588
Office Version
365, 2019, 2016
Platform
Windows
Try this,

Code:
Sub DelCol()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim r As Range: Set r = Range("C2:KZ2")
Dim AR() As Variant: AR = r.Value
Dim FC As Integer: FC = r.Cells(1, 1).Column()
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")


For i = UBound(AR, 2) To 1 Step -1
    If Not AL.contains(AR(1, i)) Then
        AL.Add AR(1, i)
    Else
        Columns(i + FC - 1).EntireColumn.Delete
    End If
Next i


Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
42,207
Office Version
365
Platform
Windows
Thanks @lrobbo314 worked like a charm :)
Perhaps it is sufficient for your needs but it does not produce the results as per your sample. The suggested code keeps the last of the duplicates (2, D and 3,F) not the first (2, B and 3, E) as in your sample.

If you want the first ones kept, and assuming your data is sorted horizontally like your sample, then try

Rich (BB code):
Sub Del_Dupes()
  Dim i As Long
  
  Application.ScreenUpdating = False
  For i = 312 To 4 Step -1
    If Cells(2, i).Value = Cells(2, i - 1).Value Then Columns(i).Delete
  Next i
  Application.ScreenUpdating = True
End Sub
 

Forum statistics

Threads
1,081,676
Messages
5,360,441
Members
400,586
Latest member
Minty

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top