Macro to switch two cells value

[meabrams]

I need macro that will basically store contents of cell once selected and on next selection store contents of that cell then paste the cell info from first selected cell into the second selected cell and the info from the second selected cell into the first then turn this feature off until active again

Coding so far

Public Bt_On As String

Sub Bt1()
Bt_On = "Yes"
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim x As Range, y As Range
Dim tmp1 As String, tmp2 As String
If Bt_On = "Yes" Then
x = Target.Address
tmp1 = x.Value

'Not sure what to put to make it work on next selection

Bt_On = ""
End If

End Sub

edit: fix code brackets

[sysss]

Hello Meabrams,

you can try this:

Option Explicit

Public Bt_On As String

Sub Bt1()
Bt_On = "Yes"
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tmp1 As String, tmp2 As String, ad As String, cl As Range
    
    If Target.Cells.Count > 1 Then
        MsgBox "You can only select single cell to make this working."
        Exit Sub
    Else
        If Bt_On = "Yes" Then
            tmp1 = Target.Value
            ad = Target.Address
            Set cl = Application.InputBox("Select another single cell", Type:=8)
            
            Do While cl.Cells.Count > 1
                Set cl = Application.InputBox("You need to pick single cell", Type:=8)
            Loop
        tmp2 = cl.Value
        cl = tmp1
        Range(ad).Value = tmp2
        Bt_On = ""
        End If
    End If
End Sub

[meabrams]

Is there a way to have this without the input box

[karedog]

Code in normal module :

Public Switcher_Status As Boolean
Public Switcher_FirstRange As Range
Sub Switcher_Start()
  Switcher_Status = True
  Set Switcher_FirstRange = Nothing
End Sub

Code in sheet module :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim arr()
  If Switcher_Status = True Then
     If Switcher_FirstRange Is Nothing Then
        Set Switcher_FirstRange = Target
     Else
        If Target.Count = 1 Then
           ReDim arr(1 To 1, 1 To 1)
           arr(1, 1) = Target.Formula
        Else
           arr = Target.Formula
        End If

        Target.ClearContents
        Target.Resize(Switcher_FirstRange.Rows.Count, Switcher_FirstRange.Columns.Count).Formula = Switcher_FirstRange.Formula

        Switcher_FirstRange.ClearContents
        Switcher_FirstRange.Resize(UBound(arr, 1), UBound(arr, 2)).Formula = arr

        Switcher_Status = False
     End If
  End If
End Sub

You need to call Sub Switcher_Start() everytime you want to do the switch (you can assign a keyboard shortcut to this sub if you use it a lot).

[meabrams]

Works like a champ thank you

[karedog]

You are welcome, glad to help.


Regards