Sort two columns in excel with matches ending up in same row

Question

Is there a simple way to sort two adjacent columns in a way that

• They are sorted alphabetically
• If an item exists in both columns it ends up in the same row
• If an item only exists in one columns the cell in the other column is empty

E.g. those columns

a   b
f   a
e   e
m   l
k   i
i   h

should be transformed into this:

a   a
    b
e   e
f   
    h
i   i
k   
    l
m   

Answer 1

I had some spare time and felt up to the challenge. So, I wrote the following VBA sub which does what you want it to do:

Option Base 0
Option Explicit

Public Sub SortThem()

Dim lngRow As Long
Dim lngItem As Long
Dim bolFound As Boolean
Dim strArray() As String
Dim strTMP(0 To 2) As String
Dim varColumn1 As Variant, varColumn2 As Variant

varColumn1 = ThisWorkbook.Worksheets(1).Range("A:A").SpecialCells(xlCellTypeConstants).Value2
varColumn2 = ThisWorkbook.Worksheets(1).Range("B:B").SpecialCells(xlCellTypeConstants).Value2

ReDim strArray(2, 0)
'Read Column1 into array
For lngRow = LBound(varColumn1) To UBound(varColumn1)
    ReDim Preserve strArray(2, UBound(strArray, 2) + 1)
    strArray(0, UBound(strArray, 2)) = varColumn1(lngRow, 1)
    strArray(1, UBound(strArray, 2)) = 1    'this "bit" should indicate that this item is / was present in Column1
Next lngRow

'Read Column2 into array
For lngRow = LBound(varColumn2) To UBound(varColumn2)
    bolFound = False
    For lngItem = LBound(strArray, 2) To UBound(strArray, 2)
        If strArray(0, lngItem) = varColumn2(lngRow, 1) Then
            bolFound = True
            strArray(2, lngItem) = 1        'note that this item is / was also present in Column2
        End If
    Next lngItem
    If bolFound = False Then
        ReDim Preserve strArray(2, UBound(strArray, 2) + 1)
        strArray(0, UBound(strArray, 2)) = varColumn2(lngRow, 1)
        strArray(2, UBound(strArray, 2)) = 1    'this "bit" should indicate that this item is / was present in Column2
    End If
Next lngRow

'Sort array
For lngRow = LBound(strArray, 2) To UBound(strArray, 2) - 1
    For lngItem = lngRow + 1 To UBound(strArray, 2)
        If strArray(0, lngRow) > strArray(0, lngItem) Then
            strTMP(0) = strArray(0, lngItem)
            strTMP(1) = strArray(1, lngItem)
            strTMP(2) = strArray(2, lngItem)

            strArray(0, lngItem) = strArray(0, lngRow)
            strArray(1, lngItem) = strArray(1, lngRow)
            strArray(2, lngItem) = strArray(2, lngRow)

            strArray(0, lngRow) = strTMP(0)
            strArray(1, lngRow) = strTMP(1)
            strArray(2, lngRow) = strTMP(2)
        End If
    Next lngItem
Next lngRow

'Write array back to sheet
For lngRow = 1 To UBound(strArray, 2)
    ThisWorkbook.Worksheets(2).Cells(lngRow, 1).Value2 = IIf(strArray(1, lngRow) = "1", strArray(0, lngRow), "")
    ThisWorkbook.Worksheets(2).Cells(lngRow, 2).Value2 = IIf(strArray(2, lngRow) = "1", strArray(0, lngRow), "")
Next lngRow

End Sub

The above sub assumes the two columns to be on the first sheet Worksheet(1) in the columns A and B. The result will be provided on the second sheet Worksheet(2) (also in columns A and B).

The basic concept behind it is:

1. Read the items from Column A and write them into the first dimension of array strArray.
2. Set the second dimension of strArray to 1. This is kind of a helper "bit" to remember that this item was in Column A.
3. Read the items from Column B. If the item is already found in the current set of strArray then also set the third dimension to 1 (to remember that this item was also found in Column B). If the item is not yet in strArray then add it and set only the third dimension to 1.
4. Sort the array strArray.
5. Write the array back to the second sheet, while checking the second and third dimension if this item was previously found in Column A and / or Column B.

Update:

Thinking about the above solution made me realize that this solution is suboptimal because the final array strArray cannot be written directly to the sheet (or a range) but merely serves as a "guideline" to do that. It is faster and more elegant if strArray can be directly written back to the sheet. Hence, I changed the above code a bit: All arrays are now 1 based to accommodate the 1-based worksheet ranges (starting with column 1 and row 1). Furthermore, the second dimension of strArray is no longer a "bit" but rather (directly) the second column to the resulting range. Hence, the array can be directly written back to the sheet (into a range). Yet, this last change made me adjust the sorting algorithm since there are now empty items in the final array.

So, the improved code (based on the above comments) is now:

Option Base 1
Option Explicit

Public Sub SortThem()

Dim lngRow As Long
Dim lngItem As Long
Dim bolFound As Boolean
Dim strArray() As String
Dim strTMP(1 To 2) As String
Dim varColumn1 As Variant, varColumn2 As Variant

varColumn1 = ThisWorkbook.Worksheets(1).Range("A:A").SpecialCells(xlCellTypeConstants).Value2
varColumn2 = ThisWorkbook.Worksheets(1).Range("B:B").SpecialCells(xlCellTypeConstants).Value2

ReDim strArray(2, 1)
'Read Column1 into array
For lngRow = LBound(varColumn1) To UBound(varColumn1)
    ReDim Preserve strArray(2, UBound(strArray, 2) + 1)
    strArray(1, UBound(strArray, 2) - 1) = varColumn1(lngRow, 1)
Next lngRow
ReDim Preserve strArray(2, UBound(strArray, 2) - 1)

'Read Column2 into array
For lngRow = LBound(varColumn2) To UBound(varColumn2)
    bolFound = False
    For lngItem = LBound(strArray, 2) To UBound(strArray, 2)
        If strArray(1, lngItem) = varColumn2(lngRow, 1) Then
            bolFound = True
            strArray(2, lngItem) = strArray(1, lngItem)
        End If
    Next lngItem
    If bolFound = False Then
        ReDim Preserve strArray(2, UBound(strArray, 2) + 1)
        strArray(2, UBound(strArray, 2)) = varColumn2(lngRow, 1)
    End If
Next lngRow

'Sort array
For lngRow = LBound(strArray, 2) To UBound(strArray, 2) - 1
    For lngItem = lngRow + 1 To UBound(strArray, 2)
        If IIf(strArray(1, lngRow) = vbNullString, strArray(2, lngRow), strArray(1, lngRow)) > _
            IIf(strArray(1, lngItem) = vbNullString, strArray(2, lngItem), strArray(1, lngItem)) Then
                strTMP(1) = strArray(1, lngItem)
                strTMP(2) = strArray(2, lngItem)

                strArray(1, lngItem) = strArray(1, lngRow)
                strArray(2, lngItem) = strArray(2, lngRow)

                strArray(1, lngRow) = strTMP(1)
                strArray(2, lngRow) = strTMP(2)
        End If
    Next lngItem
Next lngRow

'Write array back to sheet
ThisWorkbook.Worksheets(2).Range("A1").Resize(UBound(strArray, 2), UBound(strArray, 1)) = Application.Transpose(strArray)

End Sub

Answer 2

Without vba you will need to do it in a couple of steps and the results will be in a different column.

1. Copy and past both columns in one column.

2. Go to Data--->Remove Duplicates.

3. Sort that column.

4. Use this column as your reference for the order. Place the following formula in the first cell: =IFERROR(INDEX(A:A,MATCH($C1,A:A,0)),"") Then copy over and down.