Excel macro to move cells matching expression one cell to the right

I want to move all the cells that match a specific search string one cell to the right in Excel 2011, but I'm a total Excel noob.

For example, with search string "A":

A A A _ _ B A A _

开发者_运维问答

into:

_ A A A _ B _ A A

NOT:

_ A _ A _ B _ A

Thanks!

---

Sub MoveRight()

    Dim rFound As Range
    Dim lFirstCol As Long
    Dim rSearch As Range

    Const sSEARCH As String = "A"

    Set rSearch = Sheet1.Cells
    'Find the first instance in the right most column
    Set rFound = rSearch.Find(sSEARCH, rSearch.Cells(1), xlValues, xlWhole, xlByColumns, xlPrevious, True)

    'If a cell was found
    If Not rFound Is Nothing Then
        'Record the column so we know when to stop
        lFirstCol = rFound.Column

        'loop through all the found cells
        Do
            rFound.Offset(0, 1).Value = rFound.Value
            rFound.ClearContents
            Set rFound = rSearch.FindPrevious(rFound)
        'stop when it wraps back around and finds the first
        'instance that you moved one cell to the right
        Loop Until rFound.Column > lFirstCol
    End If

End Sub

Make sure you save a backup of your file before you run this macro. If it doesn't do what you want, there's no undo.