CODEWITHSUNDEEP
vbaexcel
cplus
cplus

Reputation: 1115

Merge data from multiple columns into one column

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?

Upvotes: 0

Views: 2310

Answers (2)

Shauno_88
Shauno_88

Reputation: 665

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

Upvotes: 1

BigBobby
BigBobby

Reputation: 443

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

Upvotes: 2

Related Questions