shift segment of a rows to next rows

[excel_learner_vba]

Data looks as below		want it as below
May 05 2019		May 05 2019	Jun 17 2019	Aug 9 2019
a		a	e	sg
rs		rs	a	dgh
1		1	45	1234
[+1]		[+1]
Jun 17 2019
e
a
45
Aug 9 2019
sg
dgh
1234

<colgroup><col><col><col><col><col></colgroup><tbody>
</tbody>

I am just stuck with this. Could you please give me a macro code or some other method to do this? thank you very much!

 

[igold]

Hi excel_learner_vba,

Welcome to the MrExcel Forum. This code works with the data you provided above. The only caveat is that you must continue to use the standard 3 letter abbreviation for the names of the months.

Also, this code will delete data that is not recoverable, please test this on a backup copy of your work.

Sub MoveText()


    Dim arr, pos, mns
    Dim val As String
    Dim lRow As Long, i As Long, c As Long, r As Long


    mns = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range("A1:A" & lRow)
    Range("A1:A" & lRow).ClearContents
    For i = LBound(arr) To UBound(arr)
        val = Left(arr(i, 1), 3)
        pos = Application.Match(val, mns, False)
        If Not IsError(pos) Then
            r = 1
            c = c + 1
            Cells(r, c) = arr(i, 1)
            r = r + 1
        Else
            Cells(r, c) = arr(i, 1)
            r = r + 1
        End If
    Next


End Sub

I hope this helps...