Combining multiple columns of different lengths into one column

[zachary217]

Hi all,
This is my first time posting, so apologies if I don't articulate what I'm looking for perfectly. I have a set of data that gives people scores based on various metrics in a grid and would like to email people who receive a score greater than 0 in any of the categories. I've come to understand that I can use mailmerge and microsoft word to do this; however, I would like to write a macro to format the data I have in excel to be in a way that's easy to use the mailmerge function with, which is where I'm stuck. Here is a picture of a sample of the type of data I have, followed by how I currently have it organized based on a macro I've currently written, and then a sample of how I'd like it to look, which could be done by using either the data in the first or second examples, whichever is easier:

Original Data:

Name	Basketball	Baseball	Tennis
a	3	2	1
b		4	2
c	1		1
d			3
e			4
f			5
g	2		6
h
i
j
k		2
l
m		1
n
o		3

<tbody>
</tbody>

How I've sorted it in a separate worksheet using a macro:

Basketball	Level	Baseball	Level	Tennis	Level
a	3	a	2	a	1
c	1	b	4	b	2
g	2	k	2	c	1
		m	1	d	3
		o	3	e	4
				f	5
				g	6

<tbody>
</tbody>

This is how I'd like it to look (using either of the first two tables):

Name	Level	Sport
a	3	Basketball
c	1	Basketball
g	2	Basketball
a	2	Baseball
b	4	Baseball
k	2	Baseball
m	1	Baseball
o	3	Baseball
a	1	Tennis
b	2	Tennis
c	1	Tennis
d	3	Tennis
e	4	Tennis
f	5	Tennis
g	6	Tennis

<tbody>
</tbody>

Any suggestions/actual VBA code would be much appreciated. Thanks!

 

[GlennUK]

You can get very close to that using the PivotTable wizard. Do Alt+D+P to start the wizard, and choose:
Multiple Consolidation Ranges/Next
I will create the Page Fields/Next
Select the original data/Add/Finish
( this will create a PivotTable )
In the actual PivotTable itself, double-click on the single figure that is the Grand Total for rows and columns
( this will drill-down and create a new sheet )
Sort and Filter the resulting list to however you want it.

That's it.

 

[lexxie2013]

I'm really impressed with the pivot table Glenn suggests. I'm going to play with that to improve my understanding of pivot tables. Possible code that will hopefully achieve the same :

Sub SortGrades()
Dim shSrc As Worksheet
Dim shDest As Worksheet

Set shSrc = Sheets("Sheet1")
Set shDest = Sheets("Sheet2")

shDest.UsedRange.ClearContents

DestRow = 1
For Sport = 1 To 3
    For i = 2 To shSrc.UsedRange.Rows.Count
        If shSrc.Cells(i, Sport + 1) <> "" Then
            With shDest
                .Cells(DestRow, 1) = shSrc.Cells(i, 1)
                .Cells(DestRow, 3) = shSrc.Cells(1, Sport + 1)
                .Cells(DestRow, 2) = shSrc.Cells(i, Sport + 1)
                DestRow = DestRow + 1
            End With
        End If
    Next
Next
End Sub

 

[zachary217]

Thanks Lexxie! That did exactly what I wanted!! The pivot table Glenn suggested also looks great, though for using it with mail merge I think it'd be easiest to use your macro that gets all the data on a single sheet. I appreciate the help and support and will try my best to dissect what the code is actually doing so I can understand it better and hopefully write up something myself next time I'm stuck like this!!

I'm really impressed with the pivot table Glenn suggests. I'm going to play with that to improve my understanding of pivot tables. Possible code that will hopefully achieve the same :

Sub SortGrades()
Dim shSrc As Worksheet
Dim shDest As Worksheet

Set shSrc = Sheets("Sheet1")
Set shDest = Sheets("Sheet2")

shDest.UsedRange.ClearContents

DestRow = 1
For Sport = 1 To 3
    For i = 2 To shSrc.UsedRange.Rows.Count
        If shSrc.Cells(i, Sport + 1) <> "" Then
            With shDest
                .Cells(DestRow, 1) = shSrc.Cells(i, 1)
                .Cells(DestRow, 3) = shSrc.Cells(1, Sport + 1)
                .Cells(DestRow, 2) = shSrc.Cells(i, Sport + 1)
                DestRow = DestRow + 1
            End With
        End If
    Next
Next
End Sub

 

[lexxie2013]

You're most welcome. Thanks for the feedback.