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
 

Some videos you may like

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,758
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
44,608
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
 

Watch MrExcel Video

Forum statistics

Threads
1,098,844
Messages
5,465,036
Members
406,409
Latest member
windiestboat

This Week's Hot Topics

Top