Command Button to Swap Cells

P

Prohock

I have a button that has the following VB connected with it. The function
will only swap the values of two cells and not the formats. I would like the
formats to be swapped as well. Any ideas?

Private Sub CommandButton1_Click()
Dim vTemp As Variant
With Selection
If .Count <> 2 Then
MsgBox "2 cells only."
Else
If .Areas.Count = 2 Then
vTemp = .Areas(1).Cells.Value
.Areas(1).Cells.Value = .Areas(2).Cells.Value
.Areas(2).Cells.Value = vTemp

Else
vTemp = .Cells(1).Value
.Cells(1).Value = .Cells(2).Value
.Cells(2).Value = vTemp
End If
End If
End With
End Sub
 
G

Gary''s Student

How about:

Sub swap_um()
Set r3 = Range("Z100")
i = 1
For Each r In Selection
If i = 1 Then Set r1 = r
If i = 2 Then Set r2 = r
If i = 3 Then Exit For
i = i + 1
Next
r1.Copy r3
r2.Copy r1
r3.Copy r2
End Sub

this uses Z100 as a scratchpad.
 
P

Prohock

Thanks Gary, it works perfect!

Gary''s Student said:
How about:

Sub swap_um()
Set r3 = Range("Z100")
i = 1
For Each r In Selection
If i = 1 Then Set r1 = r
If i = 2 Then Set r2 = r
If i = 3 Then Exit For
i = i + 1
Next
r1.Copy r3
r2.Copy r1
r3.Copy r2
End Sub

this uses Z100 as a scratchpad.
 
Q

Qwerx

Here's a version that combines both concepts and cleans up after itself.

Sub SwapCells()
Set r3 = Range("T3") ' Or whereever else isn't being used
i = 1
With Selection
If .Count <> 2 Then
MsgBox "2 cells only."
Else
For Each r In Selection
If i = 1 Then Set r1 = r
If i = 2 Then Set r2 = r
If i = 3 Then Exit For
i = i + 1
Next
r1.Copy r3
r2.Copy r1
r3.Copy r2
r3.Clear
End If
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top