Compare 2 columns and line up matching entries.

Sub arrangeA_B()
Dim last_row As Integer
Dim my_range As Range
Dim rag, c As Range
Dim temp
    
    last_row = Range("B" & Rows.count).End(xlUp).Row
    For x = 1 To last_row
        Set c = Range("A:A").Find(Range("B" & x).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            If c.Row <> x And Range("B" & x).Value <> "" Then
                If c.Offset(0, 1).Value = Range("B" & x).Value Then
                    R = MsgBox("Duplication " & Range("B" & x).Value, vbOKOnly)
                    Exit Sub
                End If
                    
                temp = c.Offset(0, 1).Value
                c.Offset(0, 1).Value = Range("B" & x).Value
                Range("B" & x).Value = temp
                x = x - 1
            End If
        Else
            Range("B" & Range("B" & Rows.count).End(xlUp).Row + 1).Value = Range("B" & x).Value
            Range("B" & x).ClearContents
        End If
    Next
    
End Sub