Merge data from multiple columns into one column

Question

I have the following:
enter image description here

I am using @BigBobby's answer to achieve this:

Sub MoveData()
Range("H5:H99").ClearContents
START_ROW = 5
START_COL = 1
STEP_COL = 2
OUTPUT_ROW = 5
OUTPUT_COL = 8
Limit_Col = 9

Row = START_ROW
Col = START_COL
Out_Row = OUTPUT_ROW
While Col < Limit_Col
    While Cells(Row, Col).Value <> ""
        Cells(Out_Row, OUTPUT_COL).Value = Cells(Row, Col).Value
        Out_Row = Out_Row + 1
        Row = Row + 1
    Wend
    Row = START_ROW
    Col = Col + STEP_COL
Wend
End Sub

But as you see, I expect to get those values which appear after a blank cell in the columns. But this code fails to pull those cells highlighted in yellow.
How to modify this code to pull all of the data which may appear after one or several blank cells?

You're getting the error because your 2nd While loop moves down the column until it finds a blank, once it finds one it moves across 2 columns. I'd suggest you just need to add in a line which identifies the last row in the column which has data in it. — Shauno_88
– Shauno_88, Commented May 20, 2015 at 1:47

BigBobby · Accepted Answer · 2015-05-20 13:56:07Z

2

The previous answer is close, but it will also copy all of the blank spaces. This code should do what you need:

Sub MoveData()

START_ROW = 5
START_COL = 1
STEP_COL = 2
OUTPUT_ROW = 5
OUTPUT_COL = 10

Row = START_ROW
Col = START_COL
Out_Row = OUTPUT_ROW
While Col < OUTPUT_COL
    While Row < ActiveSheet.UsedRange.Rows.Count
        If Cells(Row, Col).Value <> "" Then
            Cells(Out_Row, OUTPUT_COL).Value = Cells(Row, Col).Value
            Out_Row = Out_Row + 1
        End If
        Row = Row + 1
    Wend
    Row = START_ROW
    Col = Col + STEP_COL
Wend
End Sub

answered May 20, 2015 at 13:56

BigBobby

4531 gold badge3 silver badges18 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

cplus Over a year ago

this is working. But it is taking so long to run the command. Why is that?

BigBobby Over a year ago

How much data do you have? It runs quickly here, but I am not testing with many rows and I have a very fast computer. One trick you can use to make macros go faster, is to include: Application.ScreenUpdating = False at the beginning of the macro, and then Application.ScreenUpdating = True at the end. That way, Excel isn't repainting the screen after every operation that affects a cell.

Shauno_88 · Accepted Answer · 2015-05-22 01:51:05Z

1

Adjust this code:

While Cells(Row, Col).Value <> ""
    Cells(Out_Row, OUTPUT_COL).Value = Cells(Row, Col).Value
    Out_Row = Out_Row + 1
    Row = Row + 1
Wend

For:

Do until row > Cells(65536, Col).End(xlUp).Row
    Cells(Out_Row, OUTPUT_COL).Value = Cells(Row, Col).Value
    Out_Row = Out_Row + 1
    Row = Row + 1
Loop

This essentially checks to see if the row has passed the last row with data, and if it has, it moves onto the next column.

Edit

To not copy across the blank cells use this:

    Do until row > Cells(65536, Col).End(xlUp).Row
        If Cells(Row, Col).Value <> "" then
            Cells(Out_Row, OUTPUT_COL).Value = Cells(Row, Col).Value
            Out_Row = Out_Row + 1
        End If
        Row = Row + 1
    Loop

edited May 22, 2015 at 1:51

answered May 20, 2015 at 1:52

Shauno_88

6658 silver badges17 bronze badges

3 Comments

cplus Over a year ago

this code runs faster that Bigbobby's answer, but it includes those blanks cells in the results as well. How to modify the code not to include those blank cells?

Shauno_88 Over a year ago

So it does! I've updated it to skip over the blank cells. I've not tested it but have a go and see if you can make it work if it doesn't already.

Shauno_88 Over a year ago

Although just seen Bigbobby's answer, I'm sure you can tinker with it to speed it up!

Collectives™ on Stack Overflow

Merge data from multiple columns into one column

2 Answers 2

2 Comments

3 Comments

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

3 Comments

Linked

Related