I have two columns for example:
A B
1 2
1 3
1 5
3 4
2 1
4 3
I want the output to come like this:
A B
1 2
1 3
1 5
3 4
I want to remove the data which gets repeated from 1 column to another. Is there any function in excel to do so?
The following code will load the Range into an Array. It will then go through each Row of the Array in turn, sort the values in the Row, and compare that against already-processed rows.
If it is new, it is added to the Output and Processed Rows - if it already exists then it is ignored. Finally, it will output the array back into the original Range
This is slightly more complicated than it needs to be, to preserve the order of elements in the first row for each combination - a simpler method would have been to sort the columns of each row into order and then just use "Remove Duplicates" on the whole thing.
The ArrayDimension code is nabbed from here, so please consider wandering over to upvote Emeka Eya
Sub RemoveDuplicateRows(Target As Range, Optional Permutations As Boolean = False)
'Target: Range to remove duplicate rows from
'Permutations: If FALSE then ignore the order of elements in the row
Dim InputArray As Variant, ArrayPointer As Long
If Permutations Then
'This is just a normal RemoveDuplicates
ReDim InputArray(0 To (Target.Columns.Count - 1))
For ArrayPointer = 1 To Target.Columns.Count
InputArray(ArrayPointer - 1) = ArrayPointer
Next ArrayPointer
Target.RemoveDuplicates Columns:=InputArray, Header:=xlNo
Else
Dim RowArray As Variant, ArrayBinding As Long
Dim OutputArray As Variant, OutputRow As Variant
Dim ProcessedRows As Variant, CurrentRow As String
Dim TransferColumn As Long
InputArray = Target.Value
ArrayBinding = LBound(InputArray, 1)
OutputRow = ArrayBinding
'Empty array the same size as the input, and a 1D array the same height
ReDim OutputArray(LBound(InputArray, 1) To UBound(InputArray, 1), LBound(InputArray, 1) To UBound(InputArray, 1))
ReDim ProcessedRows(LBound(InputArray, 1) To UBound(InputArray, 1))
For ArrayPointer = ArrayBinding To UBound(InputArray, 1)
'Get 1D array containing just this specific row
RowArray = Application.Transpose(Application.Transpose(Application.Index(InputArray, ArrayPointer + 1 - ArrayBinding, 0)))
'Sort the Array and Flatten into a string for Searching
CurrentRow = SortArrayAndFlatten(RowArray)
'If the row is new, then add it
If UBound(Filter(ProcessedRows, CurrentRow)) < 0 Then
For TransferColumn = LBound(RowArray) To UBound(RowArray)
OutputArray(OutputRow, TransferColumn) = RowArray(TransferColumn)
Next TransferColumn
'Mark the row as already processed
ProcessedRows(OutputRow) = CurrentRow
OutputRow = OutputRow + 1
End If
Next ArrayPointer
Target.Clear
Target.Value = OutputArray
End If
End Sub
Private Function SortArrayAndFlatten(ByVal TargetArray As Variant) As String
'This will output a String of the Sorted Elements of the Array
If Not IsArray(TargetArray) Then Exit Function
'Only work on 1D arrays
If ArrayDimension(TargetArray) > 1 Then Exit Function
Dim OuterLoop As Long, InnerLoop As Long, StoppingPoint As Long, HoldingBucket As Variant, NoSwaps As Boolean
StoppingPoint = LBound(TargetArray) + 1
For OuterLoop = UBound(TargetArray) To StoppingPoint Step -1
NoSwaps = True
For InnerLoop = OuterLoop To StoppingPoint Step -1
If TargetArray(InnerLoop) > TargetArray(InnerLoop - 1) Then
'Swap the elements
HoldingBucket = TargetArray(InnerLoop)
TargetArray(InnerLoop) = TargetArray(InnerLoop - 1)
TargetArray(InnerLoop - 1) = HoldingBucket
NoSwaps = False
End If
Next InnerLoop
If NoSwaps Then Exit For
Next OuterLoop
SortArrayAndFlatten = Join(TargetArray, "|")
End Function
Function ArrayDimension(ByRef ArrayX As Variant) As Long
Dim i As Long, a As String, arDim As Long
On Error Resume Next
i = 0
Do
a = CStr(ArrayX(0, i))
If Err.Number > 0 Then
arDim = i
On Error GoTo 0
Exit Do
Else
i = i + 1
End If
Loop
If arDim = 0 Then arDim = 1
ArrayDimension = arDim
End Function
This may helps you
Option Explicit
Sub test()
Dim LastRow As Long, i As Long, j As Long
Dim strA_I As String, strB_I As String, strA_J As String, strB_J As String, strDelete As String
Dim varDelete As Variant
strDelete = ""
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
strA_I = .Range("A" & i).Value
strB_I = .Range("B" & i).Value
For j = i + 1 To LastRow
strA_J = .Range("A" & j).Value
strB_J = .Range("B" & j).Value
If ((strA_I = strA_J) Or (strA_I = strB_J)) And ((strB_I = strA_J) Or (strB_I = strB_J)) Then
If strDelete = "" Then
strDelete = j
Else
strDelete = strDelete & "," & j
End If
End If
Next j
Next i
varDelete = Split(strDelete, ",")
For i = LastRow To 1 Step -1
For j = LBound(varDelete) To UBound(varDelete)
If i = varDelete(j) Then
Rows(i).EntireRow.Delete
Exit For
End If
Next j
Next i
End With
End Sub
This is actually pretty easy to do, but.... There's a minor issue, we don't have a complete definition of the problem.
"I want to remove the data which gets repeated from 1 column to another."
What happens when left and right columns are identical? This is presently undefined.
Start from the bottom row and concatenate the left and right column with a delimeter. If desired, test them to see if left and right are identical to each other and figure out what to do if they are; do you keep one? Toss both?. If kept, this string becomes the first element in an expanding array.
If you kept the first pair then you'll keep this pair as well, so swap the columns to build the reverse string and put it in the second element of the array.
Move up to the next row. Test for equivalency if desired, build your string. Only add the string to the array if it is a unique.
Create the reverse string, and add it to the array if unique.
Delete the row if either string exists in the array.
Repeat all the way to the top.
If one has the Dyanmic Array formula UNIQUE then use this:
=TRIM(MID(SUBSTITUTE(UNIQUE(IF($A$1:$A$6<$B$1:$B$6,$A$1:$A$6,$B$1:$B$6)&"|"&IF($A$1:$A$6>=$B$1:$B$6,$A$1:$A$6,$B$1:$B$6)),"|",REPT(" ",999)),(COLUMN(A1)-1)*999+1,999))
Put that in the first output cell and drag over one column.
