Are these macros correct and can be improved ?

[sdfjh87687]

Hi !

I'm excel newbie, but in past I have met with dirty things as whitespaces in cells.
It may completelly destroy your formulas and other stuff. Therefore I got these two macros. They work, but I need to know, whether there is no glitch in them. Are they correct please ?

Macro 1 (for sheet only):

Public Sub Trim_current_sheet_only()
    Dim aCell As Range
    Dim aString As String
  
    For Each aCell In ActiveSheet.UsedRange
        If Not aCell.HasFormula Then
            aString = Trim(aCell)
            If aCell.Value <> aString Then
                aCell.Value = aString
            End If
        End If
    Next aCell
End Sub

Macro 2 (for workbook):

Public Sub Trim_current_workbook_whole()
    Dim aWorksheet As Worksheet
    Dim aCell As Range
    Dim aString As String
  
    For Each aWorksheet In ActiveWorkbook.Worksheets
        For Each aCell In aWorksheet.UsedRange
            If Not aCell.HasFormula Then
                aString = Trim(aCell)
                If aCell.Value <> aString Then
                    aCell.Value = aString
                End If
            End If
        Next aCell
    Next aWorksheet
End Sub

This macro is for swapping selected cells:

Sub SwapSelectedCells_LONG()
    Dim uiSource As Range
    Dim uiDestination As Range
    Dim temp As Variant
  
    On Error Resume Next
    Set uiSource = Application.InputBox("Select the source range", Default:=Selection.Address, Type:=8)
    On Error GoTo 0
    If uiSource Is Nothing Then Exit Sub: Rem cancel pressed.
  
    On Error Resume Next
    Set uiDestination = Application.InputBox("Select the other range", Type:=8)
    On Error GoTo 0
    If uiDestination Is Nothing Then Exit Sub: Rem cancel pressed.
  
    With uiSource
        temp = .Value
        .Value = uiDestination.Resize(.Rows.Count, .Columns.Count).Value
        uiDestination.Resize(.Rows.Count, .Columns.Count).Value = temp
    End With
End Sub

This macro swaps rows:
is it correct, no glitch in it ?

Sub SwapRows_FAST()
Dim xlong As Long
If Selection.Areas.Count <> 2 Then
MsgBox "Must have exactly two areas for swap." & Chr(10) _
& "You have " & Selection.Areas.Count & " areas."
Exit Sub
End If
If Selection.Areas(1).Columns.Count <> Cells.Columns.Count Or _
Selection.Areas(2).Columns.Count <> Cells.Columns.Count Then
MsgBox "Must select entire Rows, insufficient columns"
Exit Sub
End If
Dim areaSwap1 As Range, areaSwap2 As Range, onepast2 As Range
'--verify that Area 2 rows follow area 1 rows
'--so that adjacent single column swap will work.
If Selection.Areas(1)(1).Row > Selection.Areas(2)(1).Row Then
Range(Selection.Areas(2).Address & "," & Selection.Areas(1).Address).Select
Selection.Areas(2).Activate
End If
Set areaSwap1 = Selection.Areas(1)
Set areaSwap2 = Selection.Areas(2)
Set onepast2 = areaSwap2.Offset(areaSwap2.Rows.Count, 0).EntireRow
areaSwap2.Cut
areaSwap1.Resize(1).EntireRow.Insert Shift:=xlShiftDown
areaSwap1.Cut
onepast2.Resize(1).EntireRow.Insert Shift:=xlShiftDown
Range(areaSwap1.Address & "," & areaSwap2.Address).Select
xlong = ActiveSheet.UsedRange.Columns.Count 'correct lastcell
End Sub

This one, swaps columns:
is it correct, no glitch in it ?

Sub SwapColumns_FAST()
Dim xlong As Long
If Selection.Areas.Count <> 2 Then
MsgBox "Must have exactly two areas for swap." & Chr(10) _
& "You have " & Selection.Areas.Count & " areas."
Exit Sub
End If
If Selection.Areas(1).Rows.Count <> Cells.Rows.Count Or _
Selection.Areas(2).Rows.Count <> Cells.Rows.Count Then
MsgBox "Must select entire Columns, insufficient rows " _
& Selection.Areas(1).Rows.Count & " vs. " _
& Selection.Areas(2).Rows.Count & Chr(10) _
& "You should see both numbers as " & Cells.Rows.Count
Exit Sub
End If
Dim areaSwap1 As Range, areaSwap2 As Range, onepast2 As Range
'--verify that Area 2 columns follow area 1 columns
'--so that adjacent single column swap will work.
If Selection.Areas(1)(1).Column > Selection.Areas(2)(1).Column Then
Range(Selection.Areas(2).Address & "," & Selection.Areas(1).Address).Select
Selection.Areas(2).Activate
End If
Set areaSwap1 = Selection.Areas(1)
Set areaSwap2 = Selection.Areas(2)
Set onepast2 = areaSwap2.Offset(0, areaSwap2.Columns.Count).EntireColumn
areaSwap2.Cut
areaSwap1.Resize(, 1).EntireColumn.Insert Shift:=xlShiftToRight
areaSwap1.Cut
onepast2.Resize(, 1).EntireColumn.Insert Shift:=xlShiftToRight
Range(areaSwap1.Address & "," & areaSwap2.Address).Select
xlong = ActiveSheet.UsedRange.Rows.Count 'correct lastcell
End Sub

And last one moves selected row(s) or column(s) in some direction which user has to type into prompt: up, down, left, right.
But I need this macro alive until I press ESC button. I need to control macro with arrow keys, to continuously move rows, colums how I need in that moment.
So, after I press one arrow button, macro should do it's job, and turns on again and wait for other input in infinte loop until I press ESC. May anyone help me remake it please:

Sub MoveRowsOrColumns()
    Dim rOriginalSelection As Range
    Dim direction As String

startOver:
    direction = LCase(InputBox("Which direction would you like to go?" & vbNewLine & "Choose from: up/down/left/right", "Direction"))

    'check if user cancelled
  If direction = "" Then Exit Sub

    Select Case direction
    Case "up", "down"
        Set rOriginalSelection = Selection.EntireRow
    Case "left", "right"
        Set rOriginalSelection = Selection.EntireColumn
    Case Else
        MsgBox "That was not a valid choice. Please try again."
        GoTo startOver
    End Select

    With rOriginalSelection
        .Select
        .Cut
        Select Case direction
        Case "up"
            .Offset(-1, 0).Select
        Case "down"
            .Offset(rOriginalSelection.Rows.Count + 1, 0).Select
        Case "left"
            .Offset(0, -1).Select
        Case "right"
            .Offset(0, rOriginalSelection.Columns.Count + 1).Select
        End Select
    End With
    Selection.Insert
    rOriginalSelection.Select
End Sub

I appreciate any help


//I'm using excel 2010. will macros work in excel 2016 too ?

 

[Monty]

Hello sdfjh87687

Currently am using excel 2013 and tested the provided macros and working really fine...So don't worry about 2016 version it will work..

Let me know any further help...Happy to help you.