Excel97 - VBA to swap data in columns or rows

Hi BlueFin,

This will not work for formatting, formulas only plain values

Sub Swap()
  Dim R1 As Range, R2 As Range, v As Variant
  If TypeName(ActiveSheet)<>"Worksheet" Then
    MsgBox "Please activate a worksheet"
    Exit Sub
  End If
  If TypeName(Selection)<>"Range" Then
    MsgBox "Please select a range"
    Exit Sub
  End If
  If Selection.Areas.Count <> 2 Then
    MsgBox "Please select a range comprising 2 separate ranges"
    Exit Sub
  End If
  Set R1 = Selection.Areas(1)
  Set R2 = Selection.Areas(2).Resize(R1.Rows.Count, R1.Columns.Count)
  v = R2.Value
  R2.Value = R1.Value
  R1.Value = v
End Sub
 
a snippet from

Bill Manville
Microsoft MVP - Excel

if you want the rest of the goodies i'll have to work myself or since Ture has dropped in he can adjust this one to include formatting etc..

:O)Bruintje

Nice!
But that code assumes that two selection ranges are of same size.

Richie, indeed but the spec was

>>If the VBA could accommodate both rows and columns and even blocks of data  (i.e. data covering more than one row or col) then that would be great

no mention of uneven range sizes

there is more with this code it works only

-for values
-and it's a function so no GUI

J.Walker got a Power Pack on his site where i saw a little nugget like this, i could pay $20 for the source but not sure if it would take the limitations of this solution away

:O)Bruintje

That's OK. I tried with two columns, one with 4 rows and other with 3 rows. It fails if you not select the same amount of rows.
Just a clarification.
Cheers

bruintje
Thanks for the code - it works fine. Is there any chance to get formula's/ formating to swap too?

HI BlueFin,

knew you where going to ask that :)

but i've some workload and dreading things to take care of first....so maybe i can come with something usefull later

:O)Bruintje

I'll leave the selection of the columns (based upon the date criteria) to you.  I recorded the following macro with relative recording enabled.  

    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.Cut
    ActiveCell.Offset(0, -3).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.Cut
    ActiveCell.Offset(0, 3).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight

In this example, I did the following:
1. selected the "F" column.
2. right-mouse drag the selected column to the "C" column.
3. selected "shift right" from the pop-up menu.
4. selected the (right-shifted) "C" column.
5. right-mouse dragged the selected column to the right of the original "E" column.
6. selected "shift right" from the pop-up menu.

good luck

Thanks aikimark.
But your macro is very specific. I need something that I can use by simply clicking on a block of cells (any block) and highlighting where I want it to go. Bruintje's solution does this fine - the only problem is that formula's get converted to values. I think Bruintje's gone cold on this - but his solution deserves the points as it stands. If I don't hear from Bruintje over the next few day's I'll accept his current answer.

If you truly want a safe swap, you will need to add a (hidden) worksheet for your code to use as intermediate storage.  That way, you can transfer all cell properties, not just the value.

In Bruintje's solution, change the "v" variable to a range in the hidden worksheet.

Good luck

not gone cold on it, and if my solution doesn't answer the question you certainly shouldn't accept it

i'm busy today but tomorrow i'll try to come up with something from aikimarks comments

Thanks aikimark
I've had a try at your suggestion but as I'm no good at VBA I can't get it work.

Little modification to bruintje's code.

i dont know if this could be useful:
'NOTE: If this code works for you, please don't accept this comment as an answer

Public Sub Swap()
 Dim R1 As Range, R2 As Range, v As Variant
 If TypeName(ActiveSheet) <> "Worksheet" Then
   MsgBox "Please activate a worksheet"
   Exit Sub
 End If
 If TypeName(Selection) <> "Range" Then
   MsgBox "Please select a range"
   Exit Sub
 End If
 If Selection.Areas.Count <> 2 Then
   MsgBox "Please select a range comprising 2 separate ranges"
   Exit Sub
 End If
 Set R1 = Selection.Areas(1)
 Selection.Areas(1).Copy
 With R1
    Set R2 = Selection.Areas(2).Resize(.Rows.Count, .Columns.Count)
    v = R2.Value
    R2.Value = .Value
    .Value = v
    R2.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
End With
End Sub

Note that you need to change
Selection.Areas(1).Copy
to the area that you want to get the format and replace R2 for R1 or viceversa.

application.ScreenUpdating=False
application.ActiveWorkbook.worksheets.Add  after:=activeworkbook.Worksheets(activeworkbook.Worksheets.Count)
activesheet.visible=false
sheets(1).select
application.ScreenUpdating=true

==============================================
define a worksheet variable used to keep track of the current worksheet and the invisible (temporary) worksheet.

Richie  - thanks I tried your code but it still copies formulas to values.
aikimark - could you show me where to put the code. I've tried replacing all occurances of "v" with your code but of course this is not correct. Any chance of getting the full picture?
Thanks

"...
thanks I tried your code but it still copies formulas to values...."
Sorry, i am lost, what do you need specially?

Ritchie
Say I have the values 1,2,3,4 in cells A1-A4 and I have the formulas =A1+1,=A2+1,=A3+1,=A4+1 in cells B1-B4 - the formulas displaying the values 2,3,4,5 respectively. When I use the "Swap" macro sure enough the values get swapped but instead of the formula =B1+1 appearing in cell A1 I get the value "2" alone - the formula has been overwritten with the value only.

In order to preserve your formulas, you will have to effect a "move" operation.  Simple copy/paste (alone) won't work, since formulas are updated.

To do this with copy/paste, you must "fix" the formulas' addresses from relative to absolute before the copy/paste operation.

aikimark
I get the general idea - but I need the code to be written for me. I'm no VBA programmer.

Bruintje - great stuff - for some reason I didn't see the e-mail alert on this. I was housekeeping and was going to close this one off by giving you the points anyway - the swap including formulas will be a great help.
Many thanks

Glad you found it, i decided to do the same cleanup and try to solve a few i know wouldn't be that hard only tehy tend to need some focus when working on it

thanks for the points