Move data from every second row to a column next to the previous row and delete empy row.

[thardy00]

Hi guys.
I'm Excel noob and I've got a sorting task to do. Manually I will do it for ages. That's why I'm kindly asking for your help.

I have a list of url links like this:

and I would like to move every second row to a column next to the previous row and delete empy row.
So it should look like that:

Is this even possible? Could someone help me with that please?

Best regards,
Tom.

 

[thardy00]

@Joe4

 

[thardy00]

It does not work propelly. It's leaving first row which is good but then it's moving odd rows which is bad.

 

[Joe4]

@Joe4

As I said before, since I am already involved this thread, you don't need to tag me. I get notified of all replies.

 

[Joe4]

It does not work propelly. It's leaving first row which is good but then it's moving odd rows which is bad.

I am confused...
That is EXACTLY what your original example shows.
I thought you said you just wanted them in column J instead of column B.

Has what you wanted changed?
If so, please show us an example of exactly what you want.

 

[Joe4]

In looking at Siddharth's code, it looks like he is not editing the original data, but doing all of this on a second sheet (so leaving the original data intact).
Even though I don't see you asking for that in your original question, is that what you want?

If so, then I had a thought about how you can easily adapt Siddharth's code for your latest requirement. Simply all a line to the bottom of his code that inserts columns to move the data over to column J, i.e.

    '~~> Insert columns to move data from column B to column J on output sheet
    wsOutput.Columns("B:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

End Sub

 

[thardy00]

Alright.

Input:

Desired output:

Joe4 script output:

Sorry for bad explanation. Im not native english speaker and it's hard for me to properly you what I mean. But as you see above your script is moving rows in bad order.

 

[Joe4]

OK, it just looks like you are being inconsistent with that data examples, so your requirements changed slightly.
Your original example has a header row in row 1, so your data started on row 2.
Your lastest example has no header row, so your data is starting on row 1.
(As you can see, these "minor" changes can make a big difference).

So you would just need to make 2 very minor edits to my code if your data actually starts on row 1:

Sub MyMoveRows()

    Dim lr As Long
    Dim r As Long
    Dim rng As Range
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Build range of column A, every other row, starting with row 3
    For r = 2 To lr Step 2
        If rng Is Nothing Then
            Set rng = Cells(r, "A")
        Else
            Set rng = Application.Union(rng, Cells(r, "A"))
        End If
    Next r
        
'   Copy range to column A, below last row
    rng.Copy Cells(lr + 2, "A")
    
'   Delete rows
    rng.EntireRow.Delete
    
'   Moved data from bottom of column A to column J starting on row 2
    Cells(Rows.Count, "A").End(xlUp).CurrentRegion.Cut
    Range("J1").Activate
    ActiveSheet.Paste
    
    Application.ScreenUpdating = True
    
End Sub

Or you could add the single row of code I posted in my previous post to the bottom of Siddharth's code.

 

[Siddharth Rout]

Could you show me both ways? I know a bit of Python and I'm trying to figure this code out myself but it is too hard for me.

BTW How can I thank you for all the help?

@Siddharth Rout​

Thank you very much. It's working as charm. Could you please help me with doing one more little adjustment. It's all good but I would like to have output from column B in column J instead of B. Is this possible to do so?

In my code, make these 3 changes. The output will be in Sheet2. Instead of B the data will show in Col J.

ONE

Change

ReDim FinalAr(1 To UBound(tmpAr) / 2, 1 To 2)

to

ReDim FinalAr(1 To UBound(tmpAr) / 2, 1 To 10)

TWO

Change

FinalAr(j, 2) = tmpAr(i + 1, 1)

to

FinalAr(j, 10) = tmpAr(i + 1, 1)

THREE

Finally change

wsOutput.Range("A1").Resize(UBound(FinalAr), 2).Value = FinalAr

to

wsOutput.Range("A1").Resize(UBound(FinalAr), 10).Value = FinalAr

 

[thardy00]

Thank you for all the support guys. I think my case is solved.
One more question do you know a good way to removing rows with duplicates but leaving whole blank rows (not treating them as a duplicate)? Right now I'm using built-in Excel "Data --> Remove duplicates" and I'm selecting a column on which I want to base my removing process and additional column in which formula

=IF(LEN(TRIM(A1))=0,ROW(),""),

is filling rows with numbers to make it not look like blank rows. Any ideas?

 

[Joe4]

Thank you for all the support guys. I think my case is solved.
One more question do you know a good way to removing rows with duplicates but leaving whole blank rows (not treating them as a duplicate)? Right now I'm using built-in Excel "Data --> Remove duplicates" and I'm selecting a column on which I want to base my removing process and additional column in which formula

=IF(LEN(TRIM(A1))=0,ROW(),""),

is filling rows with numbers to make it not look like blank rows. Any ideas?

The typical rule of thumb is if you have an entirely new question (that is not dependent on your previous one), it is usually best to post it to a new thread.
That way it appears as a new question in the "Unanswered threads" that many people use to look for new questions to answer.