Macro Needed to Move Info from Column A to Column B and C

[rsrasc]

Hi all,

I have over 500 records in Col A in the following format:



XXX-XX-0065-0 REG-PT
XXX-XX-0119-0 REG-FT
XXX-XX-1106-0 FRS
.
.
.


The numbers after the XXX-XX-????-0, illustrated with ???? varies.


What I need is a macro to move any three of these letters found in Column A to Column C and one row up.

REG-PT
REG-FT
FRS

Also, I would like a macro to move any one of these XXX-XX-????-0 to Column B and one row up.

Hoping there is a solution.

Thank you in advance for your support.

Regards,
rsrasc

[NoSparks]

You're not telling us where your data starts in column A, if there are blank cells in column A, nor if these are the only letters possible.
It's hard to beat an actual spreadsheet for showing typical data and its layout.

That being said, based on what you've illustrated, maybe this...

Sub MoveData()
Dim cl As Range, ray As Variant
For Each cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
    ray = Split(cl.Value, " ")
    cl.Offset(-1, 1).Value = ray(0)
    cl.Offset(-1, 2).Value = ray(1)
    cl.ClearContents
Next cl
End Sub

[rsrasc]

Originally Posted by NoSparks

You're not telling us where your data starts in column A, if there are blank cells in column A, nor if these are the only letters possible.
It's hard to beat an actual spreadsheet for showing typical data and its layout.

That being said, based on what you've illustrated, maybe this...

Sub MoveData()
Dim cl As Range, ray As Variant
For Each cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
    ray = Split(cl.Value, " ")
    cl.Offset(-1, 1).Value = ray(0)
    cl.Offset(-1, 2).Value = ray(1)
    cl.ClearContents
Next cl
End Sub

Hi NoSparks

The data starts in cell A2 and goes all the way to cell A655. There are no blanks in Column A, and the three letters I mentioned before are the only choices or options available.

The macro is giving me Run-time error "9": Subscripts out of range.

Here is a sample of how the information looks like in Column A starting in A2.

Of course, I changed the names.

JOHN SMITH1
XXX-XX-2953-0 REG-PT
JOHN SMITH2
XXX-XX-0184-0 REG-PT
JOHN SMITH3
XXX-XX-3676-0 REG-FT
JOHN SMITH4
XXX-XX-1956-0 REG-FT
JOHN SMITH5
XXX-XX-0441-0 REG-PT
JOHN SMITH5
XXX-XX-5914-0 REG-PT
JOHN SMITH5
XXX-XX-9658-0 FRS


Hoping this will help!

Thanks again for your support.

rsrasc

[NoSparks]

try this

Sub Move_Info()

    Dim lr As Long, i As Long
    Dim ray As Variant

Application.ScreenUpdating = False

With ActiveSheet
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    For i = 3 To lr Step 2
        Set ray = Nothing
        ray = Split(.Cells(i, "A").Value, " ")
        .Cells(i - 1, "B").Value = ray(0)
        .Cells(i - 1, "C").Value = ray(1)
        .Cells(i, "A").ClearContents
    Next i
End With

Application.ScreenUpdating = True

End Sub

[rsrasc]

Thanks NoSparks. Working great!

Quick question? If I want this macro to start in row 5 or 10, what will be the code?

I changed some of your code but the results were not the same.

Thanks!
rsrasc

[NoSparks]

In the last code posted this line

  For i = 3 To lr Step 2

tells Excel to start looping from the first row to process, in this case 3
to the last row in the column, lr, which was calculated in the preceding line of code
and to work on every second row, the Step 2 part.

Hope that helps.