Consolidating Data into a Single Column

[stevembe]

Firstly thank you for taking the time to read. The issue I have is that I have been given a spreadsheet that is a report generated from a survey but the data is all over the place and spans across different columns.

For example Column A is labelled Age Range and has data entries for those aged 20 – 25. The problem I have is that Column B is also labelled Age Range and has entries for those aged 26 -30. Similarly Column C is also labelled Age Range and has entries for those aged 31 to 35 and again Column D labelled Age Range with those 36 to 40. Is there any way I can get all of this data into Column A?

 

[Joe4]

Are you saying that you just want to take all the data from columns B and C and copy to the bottom of column A?

If so, try this:

Sub MyCopy()

    Dim lastRowA As Long
    Dim lastRow As Long
    Dim myCol As Long
    Dim firstCol As Long
    Dim lastCol As Long
    
'   Set first and last columns to move
    firstCol = 2    '(column B)
    lastCol = 3     '(column C)
    
    Application.ScreenUpdating = False
    
'   Loop through columns B and C
    For myCol = firstCol To lastCol
'       Find last row with data in column A
        lastRowA = Cells(Rows.Count, "A").End(xlUp).Row
'       Find last row with data in current column
        lastRow = Cells(Rows.Count, myCol).End(xlUp).Row
'       Copy data to bottom of column A, starting with row 2 (skip header)
        Range(Cells(2, myCol), Cells(lastRow, myCol)).Copy Cells(lastRowA + 1, "A")
    Next myCol
    
'   Delete columns
    Range(Cells(1, firstCol), Cells(1, lastCol)).EntireColumn.Delete Shift:=xlToLeft

    Application.ScreenUpdating = True

End Sub

 

[stevembe]

Are you saying that you just want to take all the data from columns B and C and copy to the bottom of column A?

If so, try this:

Sub MyCopy()

    Dim lastRowA As Long
    Dim lastRow As Long
    Dim myCol As Long
    Dim firstCol As Long
    Dim lastCol As Long
    
'   Set first and last columns to move
    firstCol = 2    '(column B)
    lastCol = 3     '(column C)
    
    Application.ScreenUpdating = False
    
'   Loop through columns B and C
    For myCol = firstCol To lastCol
'       Find last row with data in column A
        lastRowA = Cells(Rows.Count, "A").End(xlUp).Row
'       Find last row with data in current column
        lastRow = Cells(Rows.Count, myCol).End(xlUp).Row
'       Copy data to bottom of column A, starting with row 2 (skip header)
        Range(Cells(2, myCol), Cells(lastRow, myCol)).Copy Cells(lastRowA + 1, "A")
    Next myCol
    
'   Delete columns
    Range(Cells(1, firstCol), Cells(1, lastCol)).EntireColumn.Delete Shift:=xlToLeft

    Application.ScreenUpdating = True

End Sub

Thanks but unfortunately the data spans out to Column AG so this wouldn't work but thank you for your time. Useful code I will use at some point.

 

[Joe4]

Thanks but unfortunately the data spans out to Column AG so this wouldn't work but thank you for your time. Useful code I will use at some point.

Not a problem. That is why I made the code as generic as I did, so you can easily edit it to accommodate different situations. So my code will have no problem handling this.

Column "AG" is the 33rd column. So all you need to do is make one small change to my code, changing:

    lastCol = 3

to

    lastCol = 33

Give it a try!

 

[stevembe]

It appears to be deleting data in certain areas, any idea why?

 

[Joe4]

I assumed that in consolidating the data from 33 columns down to 1, you would want to delete all those columns and just leave the one. Is that not what you want to do?
If not, remove the last line of code under 'Delete columns

 

[stevembe]

I assumed that in consolidating the data from 33 columns down to 1, you would want to delete all those columns and just leave the one. Is that not what you want to do?
If not, remove the last line of code under 'Delete columns

Working Perfectly now, thank you so much for your time, it really is appreciated.

 

[Joe4]

You are welcome!