Friday, September 16, 2011

Flip selected cells in excel (Macro)

This Macro will flip the selected cells in a row or column.

Sometimes we need to reverse the order of the cells in excel for which this macro will be helpful.

The code is given below which you can copy to your excel macro.

For those who don't know about macro, here is a step wise instruction.
1. Open the excel in which u want to reverse the cell order.
2. From excel tools menu select Macros and then visual basic editor. Or simply press Alt+F11 in excel which will open Microsoft Visual Basic editor.
3. Select the excel u want to save the macro form the project list and choose the "ThisWorkbook"
4. Copy the code form this page and paste it in the editor.
5. Save the project and close the Visual basic editor.
6. You can run the macro from the excel form Tools>Macro>Macros which will display you the list of macros present in the excel form which you can select Flip_Cells and press Run.

***********************************************************
Code:

Sub Flip_Cells()
Dim Arr() As Variant
Dim Range As Range
Dim i As Range
Dim Row As Long
Dim Column As Long
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set Range = Selection
Row = Selection.Rows.Count
Column = Selection.Columns.Count
If Row > 1 And Column > 1 Then
MsgBox "Must select either a range of rows or columns, but not simultaneaously columns and rows.", _
vbExclamation, "Reverse Rows or Columns"
Exit Sub
End If
If Range.Cells.Count = ActiveCell.EntireRow.Cells.Count Then
MsgBox "Can't select an entire row.", vbExclamation, _
"Reverse Rows or Columns"
Exit Sub
End If
If Range.Cells.Count = ActiveCell.EntireColumn.Cells.Count Then
MsgBox "Can't select an entire column.", vbExclamation, _
"Reverse Rows or Columns"
Exit Sub
End If
If Row > 1 Then
ReDim Arr(Row)
Else
ReDim Arr(Column)
End If
Row = 0
For Each i In Range
Arr(Row) = i.Formula
Row = Row + 1
Next i
Row = Row - 1
For Each i In Range
i.Formula = Arr(Row)
Row = Row - 1
Next i
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
***********************************************************

No comments:

Post a Comment