How to transpose multiple rows of an array into a single column & preserve order of values

[tavajava]

Hi all,

I hope someone can help, I'm at my wits end! have a large data set that represents births by age of the mother for each county. Mother's age is represented on my x axis, the county code on my y axis, and the birth counts for each age are reflected in a single row for each county.

I am trying to convert the rows into a single column while preserving the order in which the values are entered. For example:

15 years old 16 years old 17 years old 18 years old
Alcona County 3 7 8 9
Berrien County 1 0 4 11


Would be transposed as:

3
7
8
9
1
0
4
11

I really don't want to copy/past, because I have many years worth of datasets I have to do this to and it will be time consuming (not to mention more prone to human error).

Any recommendations? Thanks in advance!!!

 

[cooper645]

try the following macro on a copy of your workbook, it should insert a sheet named transposed and transpose as per your needs.

Please amend the code in red to be whatever your sheet name is that your data set is stored on.

[COLOR=#0000ff]Option Explicit[/COLOR]

[COLOR=#0000ff]Sub[/COLOR] Tavajava()


[COLOR=#0000ff]Dim[/COLOR] Cnt [COLOR=#0000ff]As[/COLOR] Long, LastCol [COLOR=#0000ff]As[/COLOR] Integer, data [COLOR=#0000ff]As[/COLOR] Worksheet


[COLOR=#0000ff]Set[/COLOR] data = Sheets("[B][COLOR=#ff0000]Sheet2[/COLOR][/B]") [COLOR=#008000]'change Sheet2 for whatever your data set sheet name is[/COLOR]


LastCol = data.Cells(1, Columns.Count).End(xlToLeft).Column - 2
   
Application.DisplayAlerts = [COLOR=#0000ff]False[/COLOR] [COLOR=#008000]'stop alert about deleting transpose sheet[/COLOR]
[COLOR=#0000ff]On Error Resume Next[/COLOR] [COLOR=#008000]'stop excel kicking off it Transposed doesn't exist[/COLOR]
Sheets("Transposed").Delete [COLOR=#008000]'if it does then delete it[/COLOR]
Application.DisplayAlerts = [COLOR=#0000ff]True[/COLOR] [COLOR=#008000]'turn alerts back on[/COLOR]
   
Sheets.Add after:=ActiveSheet [COLOR=#008000]'add a new sheet[/COLOR]
ActiveSheet.Name = "Transposed" [COLOR=#008000]'name the new Sheet Transposed[/COLOR]
   
   [COLOR=#008000]'loop through the range transposing to new sheet[/COLOR]
   [COLOR=#0000ff]For[/COLOR] Cnt = 2 [COLOR=#0000ff]To[/COLOR] data.Range("A" & Rows.Count).End(xlUp).Row
      [COLOR=#0000ff]With[/COLOR] Sheets("Transposed").Range("A" & Rows.Count).End(xlUp)
         .Offset(1).Value = data.Range("B" & Cnt).Value
         .Offset(2).Resize(LastCol).Value = Application.Transpose(data.Range("C" & Cnt).Resize(, LastCol))
      [COLOR=#0000ff]End With[/COLOR]
   [COLOR=#0000ff]Next[/COLOR] Cnt


[COLOR=#0000ff]End Sub[/COLOR]