Swap contents of two cells

S

Sterling

I need some help with the code for a VBA routine that will swap the contents
of two cells. Here's what I want to be able to do...ctrl-highlight 2 cells
then click on a button that will swap the contents of those two files. They
won't be formulas so I don't have to worry about cell references. I would
prefer that the formatting not be copied, only the values. I've seen code
like this:

Private Sub CommandButton1_Click()
cel1 = InputBox("First cell?")
cel2 = InputBox("Second cell?")
c1 = Range(cel1).Value
c2 = Range(cel2).Value
Range(cel1).Value = c2
Range(cel2).Value = c1
End Sub

But I'd rather not use the InputBox to enter the cells.
Thanks.
 
D

Dave Peterson

Maybe something like:

Option Explicit
Private Sub CommandButton1_Click()
Dim Cell1 As Range
Dim Cell2 As Range
Dim Temp As Variant
Dim myRng As Range

Set myRng = Selection

If myRng.Cells.Count <> 2 Then
MsgBox "exactly 2 cells!"
Exit Sub
End If

If myRng.Areas.Count = 1 Then
Set Cell1 = myRng.Cells(1)
Set Cell2 = myRng.Cells(2)
Else
Set Cell1 = myRng.Areas(1).Cells(1)
Set Cell2 = myRng.Areas(2).Cells(1)
End If

Temp = Cell1.Value
Cell1.Value = Cell2.Value
Cell2.Value = Temp

End Sub
 
R

Ron Rosenfeld

I need some help with the code for a VBA routine that will swap the contents
of two cells. Here's what I want to be able to do...ctrl-highlight 2 cells
then click on a button that will swap the contents of those two files. They
won't be formulas so I don't have to worry about cell references. I would
prefer that the formatting not be copied, only the values. I've seen code
like this:

Private Sub CommandButton1_Click()
cel1 = InputBox("First cell?")
cel2 = InputBox("Second cell?")
c1 = Range(cel1).Value
c2 = Range(cel2).Value
Range(cel1).Value = c2
Range(cel2).Value = c1
End Sub

But I'd rather not use the InputBox to enter the cells.
Thanks.
Click to expand...


After selecting two cells with <ctrl>-click, try this:

====================
Option Explicit

Sub Swap()
Dim c As Range
Dim temp(1) As Variant
Dim i As Long

If Selection.Count <> 2 Then
MsgBox ("Can only select two cells, Try again")
Exit Sub
End If

For Each c In Selection
temp(i) = c.Value
i = i + 1
Next c

For Each c In Selection
i = i - 1
c.Value = temp(i)
Next c

End Sub
===================


--ron
 
S

Sterling

Thanks to both of you. Much appreciated.

Ron Rosenfeld said:
After selecting two cells with <ctrl>-click, try this:

====================
Option Explicit

Sub Swap()
Dim c As Range
Dim temp(1) As Variant
Dim i As Long

If Selection.Count <> 2 Then
MsgBox ("Can only select two cells, Try again")
Exit Sub
End If

For Each c In Selection
temp(i) = c.Value
i = i + 1
Next c

For Each c In Selection
i = i - 1
c.Value = temp(i)
Next c

End Sub
===================


--ron
Click to expand...
 
Top