Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Swap part of 2 columns
I would like to select a range comprising 2 columns (ie: a13:B34) and click a
button and it would swap the values (ie: a13 would become b13 and b13 would become a13 for row 13 through 34. How would I code such a feat? Thank you, QB |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Swap part of 2 columns
This is a general routine which will swap to selected areas, means you
have to select the two columns seperately. Press the ctrl button when selecting the 2nd area to retain the selection of the first area. Sub swap_areas() Dim buf As Variant Dim i As Long Dim xlong As Long Dim areaSwap1 As Range, areaSwap2 As Range, onepast2 As Range If Not ActiveWorkbook Is Nothing Then If Selection.Areas.Count < 2 Then If Selection.Cells.Count = 2 Then ' simple swap of two cells in one area buf = Selection.Cells(1) Selection.Cells(1) = Selection.Cells(2) Selection.Cells(2) = buf Else MsgBox "Must have exactly two areas or two cells for swap." & Chr(10) _ & "You have " & Selection.Areas.Count & " areas." Exit Sub End If Else If Selection.Areas(1).Rows.Count = Range ("A1").EntireColumn.Rows.Count Then ' we have complete columns for swapping ' David McRitchie, 2004-01-05, http://www.mvps.org/dmcritchie/swap.htm ' and mods by me 2007-01-17 '--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 ElseIf Selection.Areas(1).Columns.Count = Range ("A1").EntireRow.Columns.Count Then ' we have complete rows to swap ' David McRitchie, 2004-01-05, http://www.mvps.org/dmcritchie/swap.htm ' with some modification by me 2007-01-17 '--verify that Area 2 rows follow area 1 rows 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 ElseIf Selection.Areas(1).Cells.Count = Selection.Areas (2).Cells.Count Then ' swap 2 areas All_off ' just in case its two very large areas For i = 1 To Selection.Areas(1).Cells.Count Application.StatusBar = Selection.Areas(1).Cells (i).Address(RowAbsolute:=False, ColumnAbsolute:=False) buf = Selection.Areas(1).Cells(i) Selection.Areas(1).Cells(i) = Selection.Areas (2).Cells(i) Selection.Areas(2).Cells(i) = buf Next i All_on Else MsgBox "The two areas have different number of cells!" & Chr(10) & _ "The two selected areas must have identical number of cells," & Chr(10) & _ "or two areas with entire rows or columns must be selected." End If End If End If End Sub Sub All_on() With Application .EnableEvents = True .DisplayAlerts = True .Calculation = xlAutomatic .ScreenUpdating = True .StatusBar = False 'Toolbars("VBA_tools").ToolbarButtons(1).Name = "Auto Calculate Off" End With End Sub Sub All_off() With Application .EnableEvents = False .DisplayAlerts = False .Calculation = xlManual .ScreenUpdating = False 'Toolbars("VBA_tools").ToolbarButtons(1).Name = "Auto Calculate On" End With End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Swap part of 2 columns
This is a general routine which will swap two selected areas, means
you have to select the two columns seperately. Press the ctrl button when selecting the 2nd area to retain the selection of the first area. Sub swap_areas() Dim buf As Variant Dim i As Long Dim xlong As Long Dim areaSwap1 As Range, areaSwap2 As Range, onepast2 As Range If Not ActiveWorkbook Is Nothing Then If Selection.Areas.Count < 2 Then If Selection.Cells.Count = 2 Then ' simple swap of two cells in one area buf = Selection.Cells(1) Selection.Cells(1) = Selection.Cells(2) Selection.Cells(2) = buf Else MsgBox "Must have exactly two areas or two cells for swap." & Chr(10) _ & "You have " & Selection.Areas.Count & " areas." Exit Sub End If Else If Selection.Areas(1).Rows.Count = Range ("A1").EntireColumn.Rows.Count Then ' we have complete columns for swapping ' David McRitchie, 2004-01-05, http://www.mvps.org/dmcritchie/swap.htm ' and mods by me 2007-01-17 '--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 ElseIf Selection.Areas(1).Columns.Count = Range ("A1").EntireRow.Columns.Count Then ' we have complete rows to swap ' David McRitchie, 2004-01-05, http://www.mvps.org/dmcritchie/swap.htm ' with some modification by me 2007-01-17 '--verify that Area 2 rows follow area 1 rows 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 ElseIf Selection.Areas(1).Cells.Count = Selection.Areas (2).Cells.Count Then ' swap 2 areas All_off ' just in case its two very large areas For i = 1 To Selection.Areas(1).Cells.Count Application.StatusBar = Selection.Areas(1).Cells (i).Address(RowAbsolute:=False, ColumnAbsolute:=False) buf = Selection.Areas(1).Cells(i) Selection.Areas(1).Cells(i) = Selection.Areas (2).Cells(i) Selection.Areas(2).Cells(i) = buf Next i All_on Else MsgBox "The two areas have different number of cells!" & Chr(10) & _ "The two selected areas must have identical number of cells," & Chr(10) & _ "or two areas with entire rows or columns must be selected." End If End If End If End Sub Sub All_on() With Application .EnableEvents = True .DisplayAlerts = True .Calculation = xlAutomatic .ScreenUpdating = True .StatusBar = False End With End Sub Sub All_off() With Application .EnableEvents = False .DisplayAlerts = False .Calculation = xlManual .ScreenUpdating = False End With End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Swap part of 2 columns
Select the data in the first column (or both, it doesn't matter), and
run the following code. Sub Swap() Dim R As Range Dim V As Variant For Each R In Selection.Columns(1).Cells V = R(1, 1).Value2 R(1, 1).Value = R(1, 2).Value2 R(1, 2).Value = V Next R End Sub This assumes that the selection has one area, no formulas, no merged cells, etc, just values. Data is swapped but formatting is not. Cordially, Chip Pearson Microsoft MVP 1998 - 2010 Pearson Software Consulting, LLC www.cpearson.com [email on web site] On Wed, 13 Jan 2010 06:05:01 -0800, QB wrote: I would like to select a range comprising 2 columns (ie: a13:B34) and click a button and it would swap the values (ie: a13 would become b13 and b13 would become a13 for row 13 through 34. How would I code such a feat? Thank you, QB |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do I swap data in columns and rows around? | New Users to Excel | |||
How to swap the contents rows and columns in a spreadsheet? | Excel Worksheet Functions | |||
swap rows and columns | Excel Discussion (Misc queries) | |||
How to swap rows and columns? | Excel Discussion (Misc queries) | |||
Swap columns A&B with C&D | Excel Programming |