Sorting and Aligning Rows

[VBAEnjoi]

I have data in n number of rows and 2 columns.
I want to sort data in rows so that the matching values of 2 columns are aligned in the same row.
The Original data set and Required outcome below:
Original Data set

Row	Column A	Column B
1	Apple2Red	Apple1Red
2	Apple1Red	Orange5Red
3	Apple1 Red	Orange1Red
4	Apple1Yellow	Apple1Yellow
5	Orange1Black	Apple1Red
6	Orange1White	Apple1Red
7	Orange5Red	Orange1White

<tbody>
</tbody>

Required outcome

Column A	Column B
Apple1 Red	Apple1Red
Apple1Red	Apple1Red
	Apple1Red
Apple1Yellow	Apple1Yellow
Apple2Red
Orange1Black
Orange1White	Orange1White
	Orange1Red
Orange5Red	Orange5Red

<tbody>
</tbody>

 

[Yongle]

Your test data is treating text with space the same as text without space
(The second Apple1 Red in column A contains a space but is treated as if it does not in your example)
- so the VBA below includes a step to remove spaces in order to return required result
- if that is not what you want, then remove that step

Your sample data
Excel 2016 (Windows) 32 bit

	A​	B​
1​	Apple2Red	Apple1Red
2​	Apple1Red	Orange5Red
3​	Apple1 Red	Orange1Red
4​	Apple1Yellow	Apple1Yellow
5​	Orange1Black	Apple1Red
6​	Orange1White	Apple1Red
7​	Orange5Red	Orange1White

Sheet: Sheet1

Sheet copied to temporary sheet and ALL spaces removed
Excel 2016 (Windows) 32 bit

	A​	B​
1​	Apple2Red	Apple1Red
2​	Apple1Red	Orange5Red
3​	Apple1Red	Orange1Red
4​	Apple1Yellow	Apple1Yellow
5​	Orange1Black	Apple1Red
6​	Orange1White	Apple1Red
7​	Orange5Red	Orange1White

Sheet: Sheet1 (2)

ALL data (from both columns) is copied to column A and duplicated in column B
Excel 2016 (Windows) 32 bit

	A​	B​
1​	Apple1Red	Apple1Red
2​	Apple1Red	Apple1Red
3​	Apple1Red	Apple1Red
4​	Apple1Red	Apple1Red
5​	Apple1Red	Apple1Red
6​	Apple1Yellow	Apple1Yellow
7​	Apple1Yellow	Apple1Yellow
8​	Apple2Red	Apple2Red
9​	Orange1Black	Orange1Black
10​	Orange1Red	Orange1Red
11​	Orange1White	Orange1White
12​	Orange1White	Orange1White
13​	Orange5Red	Orange5Red

Sheet: DataDuplicated

Unwanted values removed from each column
Excel 2016 (Windows) 32 bit

	A​	B​
1​	Apple1Red	Apple1Red
2​	Apple1Red	Apple1Red
3​		Apple1Red
4​
5​
6​	Apple1Yellow	Apple1Yellow
7​
8​	Apple2Red
9​	Orange1Black
10​		Orange1Red
11​	Orange1White	Orange1White
12​
13​	Orange5Red	Orange5Red

Sheet: ValuesCleared

Resultant empty rows deleted
Excel 2016 (Windows) 32 bit

	A​	B​
1​	Apple1Red	Apple1Red
2​	Apple1Red	Apple1Red
3​		Apple1Red
4​	Apple1Yellow	Apple1Yellow
5​	Apple2Red
6​	Orange1Black
7​		Orange1Red
8​	Orange1White	Orange1White
9​	Orange5Red	Orange5Red

Sheet: Result

Sub SortData()
    Dim ws As Worksheet, sh As Worksheet
    Dim cel As Range, celA As Range, celB As Range, rngA As Range, rngB As Range, rngA2 As Range, rngB2 As Range, Del As Range
    Dim r As Long, txt As String
    
[I][COLOR=#006400]'add sheet and remove all spaces from text[/COLOR][/I]
    Sheets("Sheet1").Copy Before:=Sheets(1)
    Set sh = Sheets(1)
    Set rngA = sh.Range("A1").CurrentRegion.Resize(, 1)
    Set rngB = rngA.Offset(, 1)
    For Each cel In Union(rngA, rngB)
        cel = Replace(cel, " ", "")
    Next

[COLOR=#006400][I]'add sheet, copy all data (both columns A&B) to column A and sort[/I][/COLOR]
    Set ws = Sheets.Add
    rngA.Copy ws.Cells(1, 1)
    rngB.Copy ws.Cells(ws.Rows.Count, 1).End(xlUp)
    ws.Range("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
[COLOR=#006400][I]'copy columnA to column B and remove items not required from each column[/I][/COLOR]
    ws.Range("A:A").Copy ws.Cells(1, 2)
    Set Del = ws.Cells(ws.Rows.Count, 1)
    For r = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 1 Step -1
        Set celA = ws.Cells(r, 1)
        Set celB = celA.Offset(, 1)
        Set rngA2 = ws.Cells(1, 1).Resize(r)
        Set rngB2 = rngA2.Offset(, 1)
        txt = celA
        If Occurs(rngA2, txt) > Occurs(rngA, txt) Then celA.ClearContents
        If Occurs(rngB2, txt) > Occurs(rngB, txt) Then celB.ClearContents
        If Len(celA) + Len(celB) = 0 Then Set Del = Union(Del, celA)
        txt = ""
    Next r
[COLOR=#006400][I]'delete blank rows and temporary sheet[/I][/COLOR]
    Del.EntireRow.Delete
    Application.DisplayAlerts = False
        sh.Delete
    Application.DisplayAlerts = True
End Sub

Private Function Occurs(xRange As Range, xText As String) As Long
    Occurs = WorksheetFunction.CountIf(xRange, xText)
End Function

 

[VBAEnjoi]

Many thanks for the detailed explanation. I will check this on my data and confirm.