Sub SortSideBySideColums()
'B___P
'Data area must be a range bounded by any combination of blank rows and blank columns
'select a cell inside this region and run macro
Dim BiColumns As Long
Dim MyARR As Variant
Dim RangeToSort As Range
Dim MyRows As Long
Dim index As Long
Dim ULCorner As String
Dim ULCorner2 As String
Dim Cella As Range
Set RangeToSort = ActiveCell.CurrentRegion 'with headers
MyRows = RangeToSort.Rows.Count
Set RangeToSort = RangeToSort.Offset(1).Resize(MyRows - 1) 'without headers
BiColumns = RangeToSort.Columns.Count / 2
MyRows = RangeToSort.Rows.Count
ULCorner = Mid(RangeToSort.Address, 1, (InStr(1, RangeToSort.Address, ":")) - 1)
ReDim MyArray(1 To BiColumns * MyRows, 1 To 2)
For Each Cella In RangeToSort
If IsNumeric(Cella) Then
index = index + 1
MyArray(index, 1) = Cella
MyArray(index, 2) = Cella.Offset(0, 1)
End If
Next Cella
Call Ordina2ColsArray(MyArray)
Application.ScreenUpdating = False
For index = LBound(MyArray) To UBound(MyArray)
Range(ULCorner).Offset(Int((index - 1) / BiColumns), 2 * ((index - 1) Mod BiColumns)) = MyArray(index, 1)
Range(ULCorner).Offset(0, 1).Offset(Int((index - 1) / BiColumns), 2 * ((index - 1) Mod BiColumns)) = MyArray(index, 2)
Next index
Application.ScreenUpdating = True
End Sub
Sub Ordina2ColsArray(inArray As Variant)
Dim x As Long
Dim y As Long
Dim temp1 As Variant
Dim temp2 As Variant
For x = LBound(inArray) To UBound(inArray) - 1
For y = x + 1 To UBound(inArray)
If inArray(x, 1) > inArray(y, 1) Then
temp1 = inArray(x, 1): temp2 = inArray(x, 2)
inArray(x, 1) = inArray(y, 1): inArray(x, 2) = inArray(y, 2)
inArray(y, 1) = temp1: inArray(y, 2) = temp2
End If
Next
Next
End Sub