If you can use a code solution...
'======================================================
' Dec 17, 2001 - created by Jim Cone
' San Francisco, USA
'----------------------------------------------------------------------
' Reverses the position of selected range data in either rows or columns.
' This is accomplished by caching the selected data in an array and then
' reading the array data backwards into the range selection.
' No functions are required.
'=======================================================
Sub FlipTheSelection()
On Error GoTo EndMacro
Application.EnableCancelKey = xlErrorHandler
Dim Rng As Range
Dim N As Long
Dim Rws As Long
Dim Cols As Long
Dim Response As Long
Dim Msg As String
Dim MsgTitle As String
MsgTitle = " Flip Selection"
N = vbExclamation '48
Select Case True
Case ActiveSheet Is Nothing
Exit Sub
Case ActiveSheet.ProtectContents
Msg = "The worksheet must be unprotected. "
Case ActiveSheet.PivotTables.Count > 0
Msg = "This program will not work on Pivot Tables. "
Case TypeName(Selection) <> "Range"
Msg = "Select at least two cells. "
Case Selection.Count = 1
Msg = "Select at least two cells. "
N = vbInformation '64
Case Selection.Areas.Count > 1
Msg = "Multiple selections will not work. "
N = vbInformation '64
Case Else
Set Rng = Selection
If WorksheetFunction.CountA(Rng) = 0 Then
Msg = "The selection is blank. "
N = vbInformation '64
Else
Rws = Rng.Rows.Count
Cols = Rng.Columns.Count
'Prevents user from doing something he probably doesn't want to do.
'If entire rows or columns selected then resize selection.
If Rws = Rows.Count Or Cols = Columns.Count Then
Set Rng = Application.Intersect(Selection, ActiveSheet.UsedRange)
Rws = Rng.Rows.Count
Cols = Rng.Columns.Count
End If
Select Case True
Case Rws = 1
Msg = "Data order in the selection will be reversed. "
MsgTitle = " Flip Row Selection"
N = 65 'vbOKCancel + vbInformation
Case Cols = 1
Msg = "Data order in the selection will be reversed. "
MsgTitle = " Flip Column Selection"
N = 65 'vbOKCancel + vbInformation
Case Else
Msg = "Yes..to reverse column data. " & vbCr & _
" No..to reverse row data."
MsgTitle = " Flip Selection - Choose..."
N = 35 'vbQuestion + YesNoCancel
End Select
If Rng.HasFormula Or IsNull(Rng.HasFormula) Then _
Msg = Msg & vbCr & vbCr & "Note: This can mess up formulas. "
End If
End Select
Application.Cursor = xlDefault
Response = MsgBox(Msg, N, MsgTitle)
If Response = vbCancel Or (N Mod 16 = 0) Then
Set Rng = Nothing
Exit Sub
End If
Dim CellArray() As Variant
Dim CalState As Long
''Following variables used by the StatusBar
' Dim StartPos As Long
' Dim Factor As Long
' Dim CellCount As Long
CalState = Application.Calculation
Msg = "[" & String$(60, 46) & " ]" 'Fill with "."
Application.StatusBar = Msg
Application.Cursor = xlWait
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Response = vbNo Or Rws = 1 Then 'Reverse Rows
ReDim CellArray(1 To Cols)
'Each row completed before the next row is done.
For Rws = 1 To Rws
With Rng.Rows(Rws)
'Read selection data into the array.
For N = 1 To Cols
CellArray(N) = Range(.Address)(N).FormulaLocal
Next
N = Cols
'Read array data back into the selection.
For Cols = 1 To Cols
Range(.Address)(Cols) = CellArray(N)
N = N - 1
Next 'Cols
End With
Cols = Cols - 1
Next 'Rws
Else 'Reverse Columns
ReDim CellArray(1 To Rws)
'Each column completed before the next column is done.
For Cols = 1 To Cols
With Rng.Columns(Cols)
'Read selection data into the array.
For N = 1 To Rws
CellArray(N) = Range(.Address)(N).FormulaLocal
Next
N = Rws
'Read array data back into the selection.
For Rws = 1 To Rws
Range(.Address)(Rws) = CellArray(N)
N = N - 1
Next 'Rws
End With
Rws = Rws - 1
Next 'Cols
End If
CleanupAndQuit:
On Error Resume Next
Erase CellArray
Set Rng = Nothing
Application.Calculation = CalState
Application.StatusBar = False
Application.Cursor = xlDefault
Application.ScreenUpdating = True
Exit Sub
EndMacro:
Beep
Application.ScreenUpdating = True
Application.Cursor = xlDefault
If Err.Number <> 18 Then
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCr & _
"Contact the programs author (James Cone) if the problem persists. ", _
vbCritical, MsgTitle
Else
If MsgBox("User interupt occurred... " & vbCr & "Continue ?", _
vbYesNo + vbQuestion, MsgTitle) = vbYes Then
Application.ScreenUpdating = False
Resume
End If
End If
Resume CleanupAndQuit
End Sub
'=========================
