This page contains some VBA macros. If you need
assistance to install or to use a macro
please refer to Getting
Started with Macros. For more depth see
Install a Macro or User Defined Function
on my Formula page.
Speed and efficiency considerations can be seen in Proper, and other Text changes and in Slow Response. |
There was a problem with adjacent single column selections that was solved by ensuring that the higher range selection area is the second area.Option Explicit Sub swapcolumns() ' David McRitchie, 2004-01-05, http://www.mvps.org/dmcritchie/swap.htm Dim xlong As Long If Selection.Areas.Count <> 2 Then MsgBox "Must have exactly two areas for swap." & Chr(10) _ & "You have " & Selection.Areas.Count & " areas." Exit Sub End If If Selection.Areas(1).Rows.Count <> Cells.Rows.Count Or _ Selection.Areas(2).Rows.Count <> Cells.Rows.Count Then MsgBox "Must select entire Columns, insufficient rows " _ & Selection.Areas(1).Rows.Count & " vs. " _ & Selection.Areas(2).Rows.Count & Chr(10) _ & "You should see both numbers as " & Cells.Rows.Count Exit Sub End If Dim areaSwap1 As Range, areaSwap2 As Range, onepast2 As Range '--verify that Area 2 columns follow area 1 columns '--so that adjacent single column swap will work. If Selection.Areas(1)(1).Column > Selection.Areas(2)(1).Column Then Range(Selection.Areas(2).Address & "," & Selection.Areas(1).Address).Select Selection.Areas(2).Activate End If Set areaSwap1 = Selection.Areas(1) Set areaSwap2 = Selection.Areas(2) Set onepast2 = areaSwap2.Offset(0, areaSwap2.Columns.Count).EntireColumn areaSwap2.Cut areaSwap1.Resize(, 1).EntireColumn.Insert Shift:=xlShiftToRight areaSwap1.Cut onepast2.Resize(, 1).EntireColumn.Insert Shift:=xlShiftToRight Range(areaSwap1.Address & "," & areaSwap2.Address).Select xlong = ActiveSheet.UsedRange.Rows.Count 'correct lastcell End SubTo test the swapColumns macro
Make a selection, then run the swapColumns macro twice to change then swap back to the original order. The active cell will always end up with the higher range area by design.
- $A:$A, $B:$B
- $B:$B, $A:$A
- $B:$B, $E:$F -- see example of SwapColumns immediately below
  A B C D E F 1 A1 B1 c1 D1 E1 F1 2 A2 B2 C2 D2 E2 F2 3 A3 B3 C3 D3 E3 F3 4 A4 B4 C4 D4 E4 F4
  A B C D E F 1 A1 E1 F1 c1 D1 B1 2 A2 E2 F2 C2 D2 B2 3 A3 E3 F3 C3 D3 B3 4 A4 E4 F4 C4 D4 B4 Manually moving Columns Around (#manual)
starting with data like above.A1 B1 C1 D1 E1 F1 G1 H1 A2 B2 C2 D2 E2 F2 G2 H2 A3 B3 C3 D3 E3 F3 G3 H3 Select columns C & D (must be one area), then Edit, Insert, Columns, which inserts 2 columns. A1 B1 --- --- C1 D1 E1 F1 A2 B2 --- --- C2 D2 E2 F2 A3 B3 --- --- C3 D3 E3 F3 move former Columns E & F to the opened up area which leave them open. You can do this with Cut (ctrl+x) then select destination and Paste (ctrl+v) delete extraneous columns by selecting then using Edit, DeleteBut there is a faster manual method you can use. Select the E&F columns and then grab the line to left of column E below the gray letter column headers and drag it to the column boundary between the columns you want to move it to while holding down the SHIFT key. Then if your intent was to swap columns you could select Column B and again move it by grabbing the boundary line at the left or right side of the selected columns below the headers while holding SHIFT and drag the column(s) to the new location at the boundary beween the columns you want to move them to. Obviously using the macro would faster and simpler, but it is always good to know how you can do something manually.
Sub swapRows() ' David McRitchie, 2004-01-05, http://www.mvps.org/dmcritchie/swap.htm Dim xlong As Long If Selection.Areas.Count <> 2 Then MsgBox "Must have exactly two areas for swap." & Chr(10) _ & "You have " & Selection.Areas.Count & " areas." Exit Sub End If If Selection.Areas(1).Columns.Count <> Cells.Columns.Count Or _ Selection.Areas(2).Columns.Count <> Cells.Columns.Count Then MsgBox "Must select entire Rows, insufficient columns" Exit Sub End If Dim areaSwap1 As Range, areaSwap2 As Range, onepast2 As Range '--verify that Area 2 rows follow area 1 rows '--so that adjacent single column swap will work. If Selection.Areas(1)(1).Row > Selection.Areas(2)(1).Row Then Range(Selection.Areas(2).Address & "," & Selection.Areas(1).Address).Select Selection.Areas(2).Activate End If Set areaSwap1 = Selection.Areas(1) Set areaSwap2 = Selection.Areas(2) Set onepast2 = areaSwap2.Offset(areaSwap2.Rows.Count, 0).EntireRow areaSwap2.Cut areaSwap1.Resize(1).EntireRow.Insert Shift:=xlShiftDown areaSwap1.Cut onepast2.Resize(1).EntireRow.Insert Shift:=xlShiftDown Range(areaSwap1.Address & "," & areaSwap2.Address).Select xlong = ActiveSheet.UsedRange.Columns.Count 'correct lastcell End SubTo test the swapRows macro
Make a selection, then run the swapRows macro twice to change then swap back to the original order. The active cell will always end up with the higher range area by design.
- $1:$1, $2:$2
- $6:$6, $16:$19
Please send your comments concerning this web page to: David McRitchie send email comments
Copyright © 1997 - 2004, F. David McRitchie, All Rights Reserved