Multiple (Specific) Columns to be stacked into another Column within the same WorkSheet (VBA Code)

[Tyjyt]

Hello, I came across an issue whilst stacking multiple (specific) columns in excel. I have 5 columns that needs to be stacked up to last non empty cell. The data changes in every column occasionally, so range of each column might be different. There I do need to include Range.End(xlUp) as well... Looking at "Stack multiple columns VBA code", I was able to gain some clarity, however, I'm met with another obstacle.

Issue: While the code that I referenced was helpful, and successful in transferring across data (names), it isn't the same for cells that contain formulas... I'd like to seek for help to the data that I'm stacking which contains formulas, and it's presented in a % format. Is there any way to copy, and paste the values (e.g 10%, 14%) into another column while excluding the formulas? I think it might be something along the lines of PasteSpecial Paste:=xlPasteValuesAndNumberFormats, but I cant seem to get the code right

Sub Test()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long
For i = 1 To 5
Lastrow = Cells(Rows.Count, Choose(i, "C", "G", "K", "O", "R")).End(xlUp).Row + 1
If i = 1 Then
Lastrowa = 2
Else
Lastrowa = Cells(Rows.Count, "V").End(xlUp).Row 'mod
End If
Range(Cells(2, Choose(i, "C", "G", "K", "O", "R")), Cells(Lastrow, Choose(i, "C", "G", "K", "O", "R"))).Copy Cells(Lastrowa + 1, "V")
Next
Application.ScreenUpdating = True
End Sub

 

[Tyjyt]

Kevin.

It already does that.
Before:

test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
1	Name	InsertWeightage	5%		Name	InsertWeightage	8%		Name	InsertWeightage	10%		Name	InsertWeightage	5%		Name	InsertWeightage	10%		Stacked Names	Stacked %
2
3	John		1%		Jonathan		1%		Gabriel		2%		John		1%		Sky		3%
4	Peter		1%		Daniel		1%		Daniel		2%		Jonathan		1%		Luke		2%
5	Andrew		1%		Damien		1%		Andrew		1%		Luke		1%		Peter		1%
6	Luke		1%		John		1%		Luke		1%		Gabriel		1%		John		3%
7	Sky		1%		Luke		1%		Sky		2%		Gerard		1%		Johnny		2%
8	Mark		0%		Mark		1%		Edward		2%
9	Mike		0%		Mike		1%
10	Gabriel		0%
11
Sheet1

Cell Formulas
Range	Formula
S3	S3	=ROW()/100

After:

test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
1	Name	InsertWeightage	5%		Name	InsertWeightage	8%		Name	InsertWeightage	10%		Name	InsertWeightage	5%		Name	InsertWeightage	10%		Stacked Names	Stacked %
2																					John	6%
3	John		1%		Jonathan		1%		Gabriel		2%		John		1%		Sky		3%		Peter	2%
4	Peter		1%		Daniel		1%		Daniel		2%		Jonathan		1%		Luke		2%		Andrew	2%
5	Andrew		1%		Damien		1%		Andrew		1%		Luke		1%		Peter		1%		Luke	6%
6	Luke		1%		John		1%		Luke		1%		Gabriel		1%		John		3%		Sky	6%
7	Sky		1%		Luke		1%		Sky		2%		Gerard		1%		Johnny		2%		Mark	1%
8	Mark		0%		Mark		1%		Edward		2%										Mike	1%
9	Mike		0%		Mike		1%														Gabriel	3%
10	Gabriel		0%																		Jonathan	2%
11																					Daniel	3%
12																					Damien	1%
13																					Edward	2%
14																					Gerard	1%
15																					Johnny	2%
16
Sheet1

Cell Formulas
Range	Formula
S3	S3	=ROW()/100

Hi Kelvin, thanks for helping me out with this. Actually, could I trouble you to refer to this Sample (updated) attached, and edit the code accordingly? Because there were a couple of pieces of information that I've missed out which might have affected the code...

M2 & Q2 are titles which I'd like to exclude as well (Not to be included as part of the names when stacked)

 

[kevin9999]

Kevin

You've provided 3 different data structures in posts #4, #6 and #11. I won't spend another minute on this until you provide what your data actually looks like using the XL2BB add in.

 

[Tyjyt]

Kevin

You've provided 3 different data structures in posts #4, #6 and #11. I won't spend another minute on this until you provide what your data actually looks like using the XL2BB add in.

Kevin

You've provided 3 different data structures in posts #4, #6 and #11. I won't spend another minute on this until you provide what your data actually looks like using the XL2BB add in.

Hi Kelvin, my deepest apologies. I am new to this, so I'd like to seek your understanding and patience. Please give me a while as I explore using XL2BB add in.

 

[Tyjyt]

Kevin

You've provided 3 different data structures in posts #4, #6 and #11. I won't spend another minute on this until you provide what your data actually looks like using the XL2BB add in.

Hi Kelvin, I've installed the add-in, as requested but I am unable to select any functions located within 'Capture the range'... I'd like to seek your understanding on this ... I will try my best to provide as much information here, along with the screenshot provided. There would be no changes after this.

As shared, I'd like to have my data stacked in Column U, Stacked Names, and Column V, Stacked Percentages respectively. However, Columns M2, and P2 have "title" in them, which are not part of the names. Hence, the starting point where data can be extracted out to the stacked columns would be "A2 & C2", "E2 & G2", "I2 & K2", "M3 & O3", "P3 & R3"

The code that you provided previously worked, but due to my lack of information, some information is being overlapped with each other, and I am deeply apologetic for, causing any inconvenience.

After extracting the data, and stacking them successfully, I'd like to be able to UNIQUE, and, if possible, to SUM the varying percentages tagged to the same name. It would look like this:
Column U (Stacked Names) | Column V (Stacked Percentages)
John | 4%
Peter | 1%
Andrew | 2%
.
.
.
Gabriel | 4%

*As there are formulas located in Columns "C", "G", "K", "O", "R", I'd only like to extract the percentage (e.g. 4%), excluding the formula
*Columns S and T are intentionally left blank
*Please ignore the highlights, as the cells are highlighted such that it's easier to see the different sets of data stacked on top of each other.

Thank you once again, Kelvin. I'm sorry for any inconvenience caused as it's not in my intention to waste anyone's time.

 

[Tyjyt]

Tyjyt: Glad to see Kevin is giving you some help. The ultimate goal here is to get you the help you need. I will continue to watch.

Thank you for being here, My Aswer Is This, I am appreciative of your presence and thoughts.

 

[kevin9999]

1. My name is Kevin. Watch how it's spelt: K - E - V - I - N. It is not Kelvin.
2. The screenshot you provided in post #14 is now the 4th different data layout you have indicated in this thread. The code below will work on the layout you provided in post #14. If you change it again, or decide it wasn't correct, then someone else will need to be willing to assist you further because I will not.

With this layout (as you provided in post # 14)

test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X
1	Name	InsertWeightage	5%		Name	InsertWeightage	8%		Name	InsertWeightage	10%		Name	InsertWeightage	5%						Stacked Names	Stacked Percentages
2	John	1.56	1%		Jonathan	1.1	1%		Gabriel	1.8	2%		Title 1			Title
3	Peter	1.77	1%		Daniel	1.3	1%		Daniel	1.9	2%		John	1.1	1%	Sky	1.6	1%
4	Andrew	1.47	1%		Damien	1.4	1%		Andrew	1.2	1%		Jonathan	1.22	1%	Luke	0.9	1%
5	Luke	2.8	1%		John	1.11	1%		Luke	1.3	1%		Luke	1.45	1%	Peter	0.5	0%
6	Sky	2.1	1%		Luke	1.15	1%		Sky	1.6	2%		Gabriel	1.7	1%	John	1.6	1%
7	Mark	1.2	0%		Mark	1.2	1%		Edward	1.75	2%		Gerard	1.2	1%	Johnny	1.2	1%
8	Mike	1.1	0%		Mike	1.3	1%
9	Gabriel	1	0%
10
Sheet1

Running this code:

Option Explicit
Sub Tyiyt_4()
    Application.ScreenUpdating = 0
    Dim Ws As Worksheet
    Set Ws = Worksheets("Sheet1")   '<<< change to actual sheet name
    Dim LRowSrc As Long, LRowDest As Long, Col
    
    Ws.Range("U1").CurrentRegion.Offset(1).ClearContents
    
    For Each Col In Array("C", "G", "K", "O", "R")
        LRowSrc = Ws.Cells(Rows.Count, Col).End(3).Row
        LRowDest = Ws.Cells(Rows.Count, "V").End(3).Row + 1
        Ws.Range(Cells(2, Col), Ws.Cells(LRowSrc, Col)).Copy
        Ws.Cells(LRowDest, "V").PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = 0
        Ws.Range(Cells(2, Col), Ws.Cells(LRowSrc, Col)).Offset(, -2).Copy Ws.Cells(LRowDest, "U")
    Next Col
    
    Dim c As Range
    LRowDest = Ws.Cells(Rows.Count, "U").End(3).Row
    For Each c In Ws.Range("U2:U" & LRowDest)
        If c = "Title" Then c.Resize(, 2).Delete xlShiftUp
    Next c
    
    Dim Ar, i As Long, n As Long
    Ar = Ws.Range("U1").CurrentRegion
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Ar, 1)
            .Item(Ar(i, 1)) = .Item(Ar(i, 1)) + Ar(i, 2)
        Next i
        Ar = Array(.keys, .items)
        n = .Count
    End With
    Ws.Range("U1").CurrentRegion.ClearContents
    Ws.Range("U1").Resize(n, 2).Value = Application.Transpose(Ar)
    
    Application.ScreenUpdating = 1
End Sub

Produces this result:

test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X
1	Name	InsertWeightage	5%		Name	InsertWeightage	8%		Name	InsertWeightage	10%		Name	InsertWeightage	5%						Stacked Names	Stacked Percentages
2	John	1.56	1%		Jonathan	1.1	1%		Gabriel	1.8	2%		Title 1			Title					John	4%
3	Peter	1.77	1%		Daniel	1.3	1%		Daniel	1.9	2%		John	1.1	1%	Sky	1.6	1%			Peter	1%
4	Andrew	1.47	1%		Damien	1.4	1%		Andrew	1.2	1%		Jonathan	1.22	1%	Luke	0.9	1%			Andrew	2%
5	Luke	2.8	1%		John	1.11	1%		Luke	1.3	1%		Luke	1.45	1%	Peter	0.5	0%			Luke	5%
6	Sky	2.1	1%		Luke	1.15	1%		Sky	1.6	2%		Gabriel	1.7	1%	John	1.6	1%			Sky	4%
7	Mark	1.2	0%		Mark	1.2	1%		Edward	1.75	2%		Gerard	1.2	1%	Johnny	1.2	1%			Mark	1%
8	Mike	1.1	0%		Mike	1.3	1%														Mike	1%
9	Gabriel	1	0%																		Gabriel	3%
10																					Jonathan	2%
11																					Daniel	3%
12																					Damien	1%
13																					Edward	2%
14																					Title 1	0%
15																					Gerard	1%
16																					Johnny	1%
17
Sheet1

 

[Tyjyt]

1. My name is Kevin. Watch how it's spelt: K - E - V - I - N. It is not Kelvin.
2. The screenshot you provided in post #14 is now the 4th different data layout you have indicated in this thread. The code below will work on the layout you provided in post #14. If you change it again, or decide it wasn't correct, then someone else will need to be willing to assist you further because I will not.

With this layout (as you provided in post # 14)

test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X
1	Name	InsertWeightage	5%		Name	InsertWeightage	8%		Name	InsertWeightage	10%		Name	InsertWeightage	5%						Stacked Names	Stacked Percentages
2	John	1.56	1%		Jonathan	1.1	1%		Gabriel	1.8	2%		Title 1			Title
3	Peter	1.77	1%		Daniel	1.3	1%		Daniel	1.9	2%		John	1.1	1%	Sky	1.6	1%
4	Andrew	1.47	1%		Damien	1.4	1%		Andrew	1.2	1%		Jonathan	1.22	1%	Luke	0.9	1%
5	Luke	2.8	1%		John	1.11	1%		Luke	1.3	1%		Luke	1.45	1%	Peter	0.5	0%
6	Sky	2.1	1%		Luke	1.15	1%		Sky	1.6	2%		Gabriel	1.7	1%	John	1.6	1%
7	Mark	1.2	0%		Mark	1.2	1%		Edward	1.75	2%		Gerard	1.2	1%	Johnny	1.2	1%
8	Mike	1.1	0%		Mike	1.3	1%
9	Gabriel	1	0%
10
Sheet1

Running this code:

Option Explicit
Sub Tyiyt_4()
    Application.ScreenUpdating = 0
    Dim Ws As Worksheet
    Set Ws = Worksheets("Sheet1")   '<<< change to actual sheet name
    Dim LRowSrc As Long, LRowDest As Long, Col
   
    Ws.Range("U1").CurrentRegion.Offset(1).ClearContents
   
    For Each Col In Array("C", "G", "K", "O", "R")
        LRowSrc = Ws.Cells(Rows.Count, Col).End(3).Row
        LRowDest = Ws.Cells(Rows.Count, "V").End(3).Row + 1
        Ws.Range(Cells(2, Col), Ws.Cells(LRowSrc, Col)).Copy
        Ws.Cells(LRowDest, "V").PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = 0
        Ws.Range(Cells(2, Col), Ws.Cells(LRowSrc, Col)).Offset(, -2).Copy Ws.Cells(LRowDest, "U")
    Next Col
   
    Dim c As Range
    LRowDest = Ws.Cells(Rows.Count, "U").End(3).Row
    For Each c In Ws.Range("U2:U" & LRowDest)
        If c = "Title" Then c.Resize(, 2).Delete xlShiftUp
    Next c
   
    Dim Ar, i As Long, n As Long
    Ar = Ws.Range("U1").CurrentRegion
   
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Ar, 1)
            .Item(Ar(i, 1)) = .Item(Ar(i, 1)) + Ar(i, 2)
        Next i
        Ar = Array(.keys, .items)
        n = .Count
    End With
    Ws.Range("U1").CurrentRegion.ClearContents
    Ws.Range("U1").Resize(n, 2).Value = Application.Transpose(Ar)
   
    Application.ScreenUpdating = 1
End Sub

Produces this result:

test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X
1	Name	InsertWeightage	5%		Name	InsertWeightage	8%		Name	InsertWeightage	10%		Name	InsertWeightage	5%						Stacked Names	Stacked Percentages
2	John	1.56	1%		Jonathan	1.1	1%		Gabriel	1.8	2%		Title 1			Title					John	4%
3	Peter	1.77	1%		Daniel	1.3	1%		Daniel	1.9	2%		John	1.1	1%	Sky	1.6	1%			Peter	1%
4	Andrew	1.47	1%		Damien	1.4	1%		Andrew	1.2	1%		Jonathan	1.22	1%	Luke	0.9	1%			Andrew	2%
5	Luke	2.8	1%		John	1.11	1%		Luke	1.3	1%		Luke	1.45	1%	Peter	0.5	0%			Luke	5%
6	Sky	2.1	1%		Luke	1.15	1%		Sky	1.6	2%		Gabriel	1.7	1%	John	1.6	1%			Sky	4%
7	Mark	1.2	0%		Mark	1.2	1%		Edward	1.75	2%		Gerard	1.2	1%	Johnny	1.2	1%			Mark	1%
8	Mike	1.1	0%		Mike	1.3	1%														Mike	1%
9	Gabriel	1	0%																		Gabriel	3%
10																					Jonathan	2%
11																					Daniel	3%
12																					Damien	1%
13																					Edward	2%
14																					Title 1	0%
15																					Gerard	1%
16																					Johnny	1%
17
Sheet1

Yup. This works. Thank you for offering your help, Kevin. I'm sorry that I've been misspelling your name, and have also caused you inconvenience. I am thankful that you are still willing to help me, this means a lot. Have a great week ahead.

 

[kevin9999]

Yup. This works. Thank you for offering your help, Kevin. I'm sorry that I've been misspelling your name, and have also caused you inconvenience. I am thankful that you are still willing to help me, this means a lot. Have a great week ahead.

No problems, glad we got there in the end