Moving data from every second row accross one cell then up one cell

[elmovs]

Hi Guys,

I had a bit of a search of the forum, but as you can imagine typing column and row into the search engine brings up a lot of threads.

I have a spreadsheet that I'm going to use as a bit of a customer database, at the moment all the data is in column A.

I need the following to happen; Every second row (2,4,6...etc) to take the information and move it to column B then up one cell.

So, A2 moves to B1, the now blank Row 2 gets deleted so A3 is now A2, the information that is now in A3 has to move to B2 and the process continues.

I'm a bit of a noob with all this kind of stuff and whilst I can understand what you're talking about for the most part I never seem to know what to use to do it myself.

Thanks for the help guys.

 

[taigovinda]

Here's one way that might work, try it on a copy of your sheet. Note that if you have error values in column A, this method would not work properly.

Option Explicit

Sub TestOnCopyOfFile()
'
With Range("B1:B" & Range("A" & Rows.Count).End(xlUp).Row)
    'For odd-numbered rows, column B copies value from column A in next row
    'For even-numbered rows, column B shows an error value
    .FormulaR1C1 = "=IF(ISODD(ROW(RC)),R[1]C[-1],NA())"
    'Copy and paste values
    .Copy
    .PasteSpecial xlPasteValues
    'Any row that contains an error value in column B, delete that entire row
    .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
End With
End Sub

...you could also loop through the rows in order to overcome that weakness, but this was the lazy way

 

[Domenic]

Try the following..

1) Alt+F11 to launch the Visual Basic Editor

2) Insert > Module

3) Copy and paste the code in the window pane on the right hand side.

4) Alt+Q to return to Excel

5) Alt+F8 to run the code

Option Explicit

Sub test()

    Dim Rng As Range
    Dim LastRow As Long
    Dim i As Long

    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Set Rng = Range("A1:A" & LastRow)
    
    Application.ScreenUpdating = False
    
    For i = LastRow To 1 Step -1
        If i Mod 2 = 0 Then
            Cells(i - 1, "B").Value = Cells(i, "A").Value
            Cells(i, "A").EntireRow.Delete
        End If
    Next i
    
    Application.ScreenUpdating = True

End Sub

 

[elmovs]

Thanks Taigovinda,

Unfortunately that deleted all of my data?? Was there a value I was supposed to change.

Also, I should have mentioned this before but I tried using an INDIRECT formula which worked, except the information is hyperlinks to websites and it removes the link is there anyway to fix that?

Thanks

 

[elmovs]

Domenic, thanks that works perfectly however it does remove the hyperlinks.

Is there anyway to keep these in?

Thanks again.

 

[Domenic]

Domenic, thanks that works perfectly...

You're welcome!

...however it does remove the hyperlinks.

Is there anyway to keep these in?

Try replacing...

Cells(i - 1, "B").Value = Cells(i, "A").Value

with

Cells(i, "A").Copy Cells(i - 1, "B")

 

[elmovs]

Worked!

You saved me a lot of time.

Thanks.