VBA Button to Swap 2 Ranges

[jimmydrsv]

I have a spreadsheet with patient information. The sheet stores room number/bed in column 1, patient name in column 2, if they are currently in the building in column 3, and patient information in column number 4. This sheet has information stored for 60 beds.

I want to be able to make a macro that will swap the data between two different beds.

For example,

103B John Doe Outside the Facility Requires Fall Alarms
127B Henry Smith Blank Space Requires Isolation for Flu

I want the macro to swap the data in the two selected ranges, but leaving the room numbers alone.

103B Henry Smith Blank Space Requires Isolation for Flu
127B John Doe Outside the Facility Requires Fall Alarms

I want to be able to select the ranges without the ranges being hard coded into the swap macro, because I won't know which patients will require moving. My preference would be a pop up dialog to request me to select each of the 2 ranges, but I am fine with anything that will get the job done. I know how to swab 2 selected cells, but I am stumped how to approach this one.

 

[FormR]

Welcome to the forum!

You could give this a try:

Sub SwapIt()


Dim s1 As String, s2 As String
Dim r1 As Range, r2 As Range
Dim temp1, temp2


s1 = InputBox("Enter Room 1")
s2 = InputBox("Enter Room 2")


Set r1 = Columns("A").Find(s1, LookIn:=xlValues, lookat:=xlWhole)
Set r2 = Columns("A").Find(s2, LookIn:=xlValues, lookat:=xlWhole)


If r1 Is Nothing Then
    MsgBox "Room 1 not found!"
    Exit Sub
End If


If r2 Is Nothing Then
    MsgBox "Room 2 not found!"
    Exit Sub
End If


temp1 = r1.Offset(, 1).Resize(, 3).Value
temp2 = r2.Offset(, 1).Resize(, 3).Value


r1.Offset(, 1).Resize(, 3).Value = temp2
r2.Offset(, 1).Resize(, 3).Value = temp1


End Sub

 

[Arithos]

Hi, and welcome =)

Just adding this code to a button

Sub Swaps() 
Dim A As String, B As String
    With Selection
                A = .Cells(1, 1).Value
                B = .Cells(2, 1).Value
                
                .Cells(1, 1).Value = B
                .Cells(2, 1).Value = A
    End With
End Sub

Then selecting the two cells in question, using Ctrl + "leftclick", then when selected press the button containing this code, and your swap is complete.

Hope its what you were looking for, if not, let me know.

 

[Arithos]

Seems I misunderstood your request.

Try this, Just select the names (column B) when two shall be moved. Then run this code in a button.

 Sub Swaps()Dim A As String, B As String
Dim C(1 To 3)
Dim D(1 To 3)
Dim i%
     A = Selection.Address
    
        B = Mid(A, InStr(1, A, ",") + 1, Len(A))
        A = Mid(A, 1, InStr(1, A, ",") - 1)
        
        For i = 1 To 3
            C(i) = Range(A).Offset(0, i - 1).Value
            D(i) = Range(B).Offset(0, i - 1).Value
            Range(B).Offset(0, i - 1).Value = C(i)
            Range(A).Offset(0, i - 1).Value = D(i)
        Next i
        


        
End Sub

 

[Arithos]

Some errorhandling missing:

Sub Swaps()Dim A As String, B As String
Dim C(1 To 3)
Dim D(1 To 3)
Dim i%
     
    If Selection.Cells.Count = 2 Then 'Some error handling
        A = Selection.Address
        B = Mid(A, InStr(1, A, ",") + 1, Len(A))
        A = Mid(A, 1, InStr(1, A, ",") - 1) 
        For i = 1 To 3
            C(i) = Range(A).Offset(0, i - 1).Value
            D(i) = Range(B).Offset(0, i - 1).Value
            Range(B).Offset(0, i - 1).Value = C(i)
            Range(A).Offset(0, i - 1).Value = D(i)
        Next i
    End If
End Sub

 

[jimmydrsv]

Welcome to the forum!

You could give this a try:

Sub SwapIt()


Dim s1 As String, s2 As String
Dim r1 As Range, r2 As Range
Dim temp1, temp2


s1 = InputBox("Enter Room 1")
s2 = InputBox("Enter Room 2")


Set r1 = Columns("A").Find(s1, LookIn:=xlValues, lookat:=xlWhole)
Set r2 = Columns("A").Find(s2, LookIn:=xlValues, lookat:=xlWhole)


If r1 Is Nothing Then
    MsgBox "Room 1 not found!"
    Exit Sub
End If


If r2 Is Nothing Then
    MsgBox "Room 2 not found!"
    Exit Sub
End If


temp1 = r1.Offset(, 1).Resize(, 3).Value
temp2 = r2.Offset(, 1).Resize(, 3).Value


r1.Offset(, 1).Resize(, 3).Value = temp2
r2.Offset(, 1).Resize(, 3).Value = temp1


End Sub

This worked perfectly. It is exactly what I wanted. Thanks!