Hi all,
After searching the forums I couldnt find a simple way to remove duplicates columns.
Preferrably I would like to avoid transposing my data, Is there any other way?
Regards,
Hi all,
After searching the forums I couldnt find a simple way to remove duplicates columns.
Preferrably I would like to avoid transposing my data, Is there any other way?
Regards,
found this on the internet!
Sub DeleteDuplicateColumns()
Dim rngData As Range
Dim arr1, arr2
Dim i As Integer, j As Integer, n As Integer
On Error Resume Next
Set rngData = ActiveSheet.UsedRange
If rngData Is Nothing Then Exit Sub
n = rngData.Columns.Count
For i = n To 2 Step -1
For j = i - 1 To 1 Step -1
If WorksheetFunction.CountA(rngData.Columns(i)) <> 0 And _
WorksheetFunction.CountA(rngData.Columns(j)) <> 0 Then
arr1 = rngData.Columns(i)
arr2 = rngData.Columns(j)
If AreEqualArr(arr1, arr2) Then
With rngData.Columns(j)
'mark column to be deleted
.Copy
If MsgBox("Delete marked column?", vbYesNo) _
= vbYes Then
rngData.Columns(j).Delete
Else
'remove mark
Application.CutCopyMode = False
End If
End With
End If
End If
Next j
Next i
End Sub
Function AreEqualArr(arr1, arr2) As Boolean
Dim i As Long, n As Long
AreEqualArr = False
For n = LBound(arr1) To UBound(arr1)
If arr1(n, 1) <> arr2(n, 1) Then
Exit Function
End If
Next n
AreEqualArr = True
End Function
you might also try![]()
Please Login or Register to view this content.
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks