How to stack multiple columns into one column automatically with specific range

Question

Hello there,

I have worksheet which include specific data for specific purpose one of the thing that I need is to specify range of columns for example A1:C10 to be stacked into one column which is D with ignoring the spaces and not listed them and I need this process to be automatically whither it keeps running in the background so any change will reflect the result directly or at least on file open. I hope you got my idea.

         A               B              C              D

1    Value1      Value4      Value7       Value1    

2    Value2      Value5      Value8       Value2

3    Value3      Value6      Value9       Value3

                                                         Value4

                                                         Value..Etc.

Remember no spaces required.

Regards.

Answer 1

Hi AlaaEddin95

Welcome to this community

I'm afraid your requirements only could be achieved using a VBA code in the worksheets event on your workbook

Let's say your scenario is in Sheet1 of your workbook

So.

1- Select the Sheet1 tab\ Right click \ View code 

2-and Paste the code in the VBA panel

as shown in picture below

Here is the Code

***********************************************************************************

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Matrix, K As Range

Dim r As Long

Set Matrix = Range("A2:C20") ''' Your Matrix range

r = 2  ''The starting row in "The List"

If Not Application.Intersect(Target, Matrix) Is Nothing Then

'''' The line below will delete old list

Range(Cells(2, "E"), Cells(Rows.Count, "E").End(xlUp)).ClearContents

''' Loop thru the matrix and update "The List"

        For Each K In Matrix

                If K.Value <> "" Then

                Cells(r, "E").Value = K.Value

                r = r + 1

                End If

        Next K

End If

End Sub

*****************************************************************************************

Note: 

Here I choose the range "A2:C20" and column "E" to make space for headers.

Please, Change the ranges as per your needs.

Please find in the link below and download a file with my approach as a solution to your requirements

https://www.dropbox.com/s/aigsuyrgjuhfmha/Matrix-List.xlsm?dl=0

*******************************************************************************************************

Do let me know if you require any further help on this. Will be glad to help you.

If this answer would be the solution to your question, I'll appreciate you mark it as answered

Please Note:

By marking a Reply as a "Accept as Solution", if it solves your problem. Will give positive reinforcement, not only to the person who responded, but also will help other users with the same or a similar question by directing them to the response.Thanks for your co-operation.

Answer 2

You are very welcome

If this answer would be the solution to your question, I'll appreciate you mark it as answered

Please Note:

By marking a Reply as a "Accept as Solution", if it solves your problem. Will give positive reinforcement, not only to the person who responded, but also will help other users with the same or a similar question by directing them to the response.Thanks for your co-operation.

Answer 3

I have noted a problem,

I am unable to copy and paste in those 2 columns I don't know why also in the column "E" I can't add title because when I navigate to column A,B or C the value in D1 will be cleared.

is there any fix for this issue?

Regards.

Answer 4

If so then change the worksheet event from SelectionChange to Change

Delete the previous macro

And use the one below

**************************************************************************

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Matrix, K As Range

Dim r As Long

Set Matrix = Range("A2:C20") ''' Your Matrix range

r = 2  ''The starting row in "The List"

If Not Application.Intersect(Target, Matrix) Is Nothing Then

'''' The line below will delete old list

Range(Cells(2, "E"), Cells(Rows.Count, "E").End(xlUp)).ClearContents

''' Loop thru the matrix and update "The List"

        For Each K In Matrix

                If K.Value <> "" Then

                Cells(r, "E").Value = K.Value

                r = r + 1

                End If

        Next K

End If

End Sub

*****************************************************************************

The file in the link has been updated as well.

Answer 5

Thanks you so much, Another thing I haven noted that if I try to "Undo" I can't

Is there any solution for this? also the problem of clearing the title in E1 it happened when I type in A2 and press enter then the title of the column which is in E1 is just been removed.

Really Really thanks, I wish I can reach your experience some day.