Solved: Delete Duplicate Colums

[fredlo2010]

Hello guys,

I have this huge data sheet I get from a program and I paste it to excel. I need to run a report and get only the data I need.

So I Created a simple procedure to find a string "my column header" and then get the rows below and copy them into another row.
The only problem is that my columns have duplicates ( the columns headers not the rows). I am trying to delete those duplicate columns.


Here is the code to select my range ( i know I shouldn't select anything, I only do it as a guide)

With Worksheets(1).Range("a1:Ez500")
Set c = .Find("My header", LookIn:=xlValues)

d = c.Cells(2, 1).Address

End With


Thanks

[Trebor76]

Hi fredlo2010,

Not sure why you want to delete columns with the same headers when you've said their rows have different data, but that said try this (initially on a copy of your data as the results cannot be undone):

Option Explicit
Sub Macro1()

'http://www.vbaexpress.com/forum/showthread.php?t=42458

Dim clnMyUniqueArray As New Collection
Dim rngCell As Range, _
rngDelRange As Range
Dim strMyText As String

'strMyText = "DeleteMe" 'Column header text to be checked (change to suit). Note duplicates will result in the entire column being deleted

Application.ScreenUpdating = False

For Each rngCell In Range(Cells(1, 1), Cells(1, Cells(Columns.Count).End(xlToLeft).Column))
If rngCell = strMyText Then
On Error Resume Next 'OK to ignore duplicate error message as we only want unique items
clnMyUniqueArray.Add Item:=rngCell.Value, Key:=CStr(rngCell)
If Err.Number <> 0 Then
If rngDelRange Is Nothing Then
Set rngDelRange = Cells(rngCell.Row, rngCell.Column)
Else
Set rngDelRange = Union(rngDelRange, Cells(rngCell.Row, rngCell.Column))
End If
End If
On Error GoTo 0
End If
Next rngCell

If Not rngDelRange Is Nothing Then
rngDelRange.Columns.Delete
Else
MsgBox "There are no matching headers for """ & strMyText & """", vbExclamation, "My Delete Column(s) Editor"
End If

Set rngCell = Nothing
Set rngDelRange = Nothing
Set clnMyUniqueArray = Nothing

Application.ScreenUpdating = True

End Sub
Regards,

Robert

[fredlo2010]

Hi Robert,

Thanks a lot for the help. The code works but it was not deleting the whole column, for that I had to change this line

rngDelRange.EntireColumn.Delete

If you don't mind, could you explain me the code a little bit. I don't understand the part of the Error handling very well. That would be awesome.


Not sure why you want to delete columns with the same headers when you've said their rows have different data

No, the columns contain the same duplicated data. Sometimes I try to explain things with so much detail that the wrong "string" comes out. So we are safe.

Btw. there is not critical information to be handled here. Its just me trying to learn as much as I can VBA (well I use office stuff to sort of fuel my motivation)

Thanks a lot again