"Flipping" a matrix

[John Wirt]

Has anyone seen VBA code for flipping a n array -- that is, moving row 1 to
the last row, row 2 to the next to last row, and so on until row N is the
first row?

Thank you.

John Wirt

 

[Tom Ogilvy]

Do you mean a VBA array or are you talking about cells on the worksheet.

If a VBA array, what are the dimensions.

If using cells, just insert a column, number it 1 to n, sort on that column
Descending, remove the column. ( if using a vba array, you could write it to
the sheet, use the same technique, pick it back up and clear the sheet. )

 

[Jim Cone]

John,

You are about the first person in about 4 years (that I know about) that has had
any interest in flipping a range. Maybe you or somebody can use this code.
I like Tom's idea of just sorting the data, but this works and it is turnkey...

Option Explicit
Option Private Module
'=========================================
' 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.
'--------------------------------------------------------------------------
' Revision History
' Dec 24, 2001 - Initial release.
' Feb 07, 2002 - If selection encompasses full rows or full columns then the selection is
' restricted to the intersection with the used range, otherwise selection is used.
' May 25, 2003 - Simplified and improved StatusBar display and saving Calculation status.
' May 31, 2003 - Revised definition of Factor variable.
'=========================================

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

StartPos = 2
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

If Rws > 99 Then 'Set StatusBar paramenters
'Rounds to nearest integer(.5 rounds up) with a minimum result of 1.
Factor = WorksheetFunction.RoundUp(Rws / 60, 0)
Else
Msg = "[" & String$(60, 73) & " ]" 'Fill with "I"
'Set Factor large enough so StatusBar display is ignored.
Factor = 999
Application.StatusBar = Msg
End If

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
'Display StatusBar
If Rws Mod Factor = 0 Then
Mid$(Msg, StartPos, 1) = Chr$(73)
Application.StatusBar = Msg
StartPos = StartPos + 1
End If
Next 'Rws

Else 'Reverse Columns

If (Cols * Rws) > 99 Then 'Set StatusBar paramenters
'Rounds to nearest integer(.5 rounds up) with a minimum result of 1.
Factor = WorksheetFunction.RoundUp((Cols * Rws) / 60, 0)
Else
Msg = "[" & String$(60, 73) & " ]" 'Fill with "I"
'Set Factor large enough so StatusBar display is ignored.
Factor = 999
Application.StatusBar = Msg
End If

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
CellCount = CellCount + 1
'Display StatusBar
If CellCount Mod Factor = 0 Then
Mid$(Msg, StartPos, 1) = Chr$(73)
Application.StatusBar = Msg
StartPos = StartPos + 1
End If
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
'---------------------------------


Has anyone seen VBA code for flipping a n array -- that is, moving row 1 to
the last row, row 2 to the next to last row, and so on until row N is the
first row?
Thank you.
John Wirt

 

[keepITcool]

Jim,

I love your select case for the verification process, a gem!

BUT:
Using FormulaR1C1 iso FormulaLocal will screwup fewer formulas
(personally i avoid all Local string like the plague, more important
to use r1c1)


FWIW:

Textually confusing:
vbYes to Reverse Column data

to the programmer means flip the data in each column,
but to a user "Yes to Flip ROWS" is clearer.
No to flip COLUMNS" is probably clearer.

When a user breaks you should finish flipping at least the current
column. (I'd use an intermediate array(1 to rows,1 to 1) to cache the
"writedata" and avoid writing to single ranges

Following code uses 2 arrays
and can be copied into your routine...

(drawback: the writing part may be unresponsive)

Dim DataArray(), lRow&, lCol&
Application.StatusBar = "Reading"
DataArray = Rng.FormulaR1C1
ReDim CellArray(1 To Rws, 1 To Cols)
Application.StatusBar = "Flipping"
For lRow = 1 To Rws
For lCol = 1 To Cols
If Response = vbNo Then
CellArray(lRow, Cols + 1 - lCol) = DataArray(lRow, lCol)
Else
CellArray(Rws + 1 - lRow, lCol) = DataArray(lRow, lCol)
End If
Next
Next
Application.StatusBar = "Writing Flipped data"
Rng.FormulaR1C1 = CellArray



--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Jim Cone wrote :

 

[Jim Cone]

kIc,

Thanks for your comments.

I like your approach, but as a general practice will not
write code that won't run in xl97 (assigning to arrays).

And yes, I have also discovered that one cannot assume
writing a Variant(containing an array) or Arrays directly
to a range is faster then plunking data directly in each cell.

If I was starting over with it, I believe that filling an index
row and sorting would be the way to go.

Regards,
Jim Cone
San Francisco, USA


Jim,

I love your select case for the verification process, a gem!
BUT:
Using FormulaR1C1 iso FormulaLocal will screwup fewer formulas
(personally i avoid all Local string like the plague, more important
to use r1c1)
FWIW:
Textually confusing:
vbYes to Reverse Column data
to the programmer means flip the data in each column,
but to a user "Yes to Flip ROWS" is clearer.
No to flip COLUMNS" is probably clearer.
When a user breaks you should finish flipping at least the current
column. (I'd use an intermediate array(1 to rows,1 to 1) to cache the
"writedata" and avoid writing to single ranges

Following code uses 2 arrays
and can be copied into your routine...

(drawback: the writing part may be unresponsive)

Dim DataArray(), lRow&, lCol&
Application.StatusBar = "Reading"
DataArray = Rng.FormulaR1C1
ReDim CellArray(1 To Rws, 1 To Cols)
Application.StatusBar = "Flipping"
For lRow = 1 To Rws
For lCol = 1 To Cols
If Response = vbNo Then
CellArray(lRow, Cols + 1 - lCol) = DataArray(lRow, lCol)
Else
CellArray(Rws + 1 - lRow, lCol) = DataArray(lRow, lCol)
End If
Next
Next
Application.StatusBar = "Writing Flipped data"
Rng.FormulaR1C1 = CellArray
--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Jim Cone wrote :

 

[Peter T]

Hi Jim,

And yes, I have also discovered that one cannot assume
writing a Variant(containing an array) or Arrays directly
to a range is faster then plunking data directly in each cell.

I know you would not say that without a good reason so I am curious, I had
always assumed just that - ie very significantly faster to read as an array,
do whatever in a helper redim'ed array and write back to cells in one go.

all versions incl xl97

Dim v As Variant
With Selection
v = Selection.FormulaR1C1
.Offset(, .Columns.Count) = v
End With

Regards,
Peter T

 

[Jim Cone]

Hello Peter,

I know of no empirical method to determine which is fastest.
It is "cut and try". In my List Files program, some of the
data is written directly to the worksheet because when I improved
it, by writing to arrays, it took longer to finish.

With my Permutations program...with an array of 30,000
to 40,000 items...it would almost grind to a halt when
trying to place the array on the sheet. That could be memory
problems caused by the recursive function it uses?
And writing the list directly goes very fast. The progress bar
that is used is for the check spelling part of the program.

I have not seen any discussion on the subject.

Regards,
Jim Cone
San Francisco, USA
Both programs mentioned above are free and available here...
http://www.realezsites.com/bus/primitivesoftware

And yes, I have also discovered that one cannot assume
writing a Variant(containing an array) or Arrays directly
to a range is faster then plunking data directly in each cell.

I know you would not say that without a good reason so I am curious, I had
always assumed just that - ie very significantly faster to read as an array,
do whatever in a helper redim'ed array and write back to cells in one go.

all versions incl xl97

Dim v As Variant
With Selection
v = Selection.FormulaR1C1
.Offset(, .Columns.Count) = v
End With

Regards,
Peter T

 

[Peter T]

Thanks Jim for coming back.

I was half anticipating you were going to say something about large
"formula" arrays, particularly returning them. But I assume the routines you
refer to, in contrast to "FlipTheSelection", merely return data (values); so
I can't quite envisage why there would be a problem with dumping an array in
one go, even with 40k elements.

However I will certainly keep your comments in mind and test both ways with
largest anticipated volumes, possibly break down into a subset of arrays.

I have briefly tried your Permutations and List Files programs. Both very
nice and thanks for making them available.

Regards,
Peter T