How to Separate One Long Column of Data into Separate Columns

[mshao]

I'm trying to isolate data from different states and I want to be able to create a macro using Vlookup to be able to locate a data point for every state for any year I input. I have attached a sample file for your reference.

In order to do so, I want to be able to isolate this one column of data from all the different states into 50 different columns that stop for each individual state. I want Alaska and its data points in one column, Alabama data in another column, and so on.

Also, is there a way to sort the states alphabetically not by their abbreviation but by their actual names?

Thanks!

16418

[p45cal]

Try the following while a sheet like your sample sheet is the active sheet, but with nothing in the cells to the right of column B:
Sub Macro1()
With ActiveSheet
Set zzz = .Range("A2").CurrentRegion
.Range("B1").Value = "no."
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
CustomOrder:="AL,AK,AS,AZ,AR,CA,CO,CT,DE,DC,FL,GA,GU,HI,ID,IL,IN,IA,KS,KY,LA,ME,MH,MD,MA, MI,FM,MN,MS,MO,MT,NE,NV,NH,NJ,NM,NY,NC,ND,MP,OH,OK,OR,PW,PA,PR,RI,SC,SD,TN, TX,VI,UT,VT,VA,WA,WV,WI,WY", _
DataOption:=xlSortNormal
.SetRange zzz
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
.Range("A1").Subtotal GroupBy:=1, Function:=xlSum, _
TotalList:=Array(1), Replace:=True, _
PageBreaks:=False, SummaryBelowData:=True
.Range("C1").ClearContents
Set yyy = _
.Columns("C:C").SpecialCells(xlCellTypeConstants, 23)
colm = 6
For Each are In yyy.Areas
are.Offset(, -1).Resize(, 2).Copy Cells(2, colm)
colm = colm + 2
Next are
.Range("B2").RemoveSubtotal
.Columns(1).Delete
End With
End Sub It leaves the original data in place.

[snb]

Start with:


Sub M_snb()
With Cells(1).CurrentRegion
.Columns(1).AdvancedFilter 2, , Cells(1, 4), True

sn = Cells(1, 4).CurrentRegion
Cells(1, 4).CurrentRegion.Offset(1).ClearContents
Range("B1,E1") = "snb"

For j = 2 To UBound(sn)
Cells(2, 4) = sn(j, 1)
.AdvancedFilter 2, Cells(1, 4).CurrentRegion, Cells(1, 7).Offset(, 2 * (j - 2))
Next
End With
End Sub

[mshao]

Thanks P45cal, it works great! Would you mind briefly explaining the code so I can be able to manipulate it in the future and also learn VBA at the same time?

[p45cal]

Thanks P45cal, it works great! Would you mind briefly explaining the code so I can be able to manipulate it in the future and also learn VBA at the same time?Briefly is difficult.


Set zzz = .Range("A2").CurrentRegion
is when you do this (F5, Special…) and click OK, what ends up being selected is assigned to the object varaible zzz:
16450

.Range("B1").Value = "no."
is:
16451
Which allows the sorting and subtotals to work properly later.

The following code sorts according to the custom sort, being the alphabet order of unabbreviated state names:
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
CustomOrder:="AL,AK,AS,AZ,AR,CA,CO,CT,DE,DC,FL,GA,GU,HI,ID,IL,IN,IA,KS,KY,LA,ME,MH,MD,MA, MI,FM,MN,MS,MO,MT,NE,NV,NH,NJ,NM,NY,NC,ND,MP,OH,OK,OR,PW,PA,PR,RI,SC,SD,TN, TX,VI,UT,VT,VA,WA,WV,WI,WY", _
DataOption:=xlSortNormal
.SetRange zzz
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

It sorts the zzz range by column A

This line:
.Range("A1").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), Replace:=True, PageBreaks:=False, SummaryBelowData:=True

is equivalent to this (Subtotal is on the Outline section of the Data tab of the Ribbon):
16455

and when OK is clicked you get this:
16456

which further down looks like this:
16457
Note the additional column A inserted and the blank cell in column C at row 103. The blank cells in column C will be used later to determine the ranges to move.

The next line:
.Range("C1").ClearContents
removes the no. that we placed there earlier (it was in cell B1 then).

The next line:
Set yyy = .Columns("C:C").SpecialCells(xlCellTypeConstants, 23)
sets the object variable yyy to whats selected when we do this: Select the entire column C and then (F5, Special…):
16458

Clicking OK gets you this:
16459

which lower down is like this:
16460
Note the non-contiguous range. This repeats all the way down to row 5202.

This line:
colm = 6
sets the variable colm to 6. It's going to be the column number of where we start to copy stuff to.

Now to loop through each of the areas in the non-contiguous range:
For Each are In yyy.Areas
'are.Select
'are.Offset(, -1).Resize(, 2).Select
are.Offset(, -1).Resize(, 2).Copy Cells(2, colm)
colm = colm + 2
Next are
I've added 2 commented-out lines which you can enable by removing the apostrophes, so that when you step through the code by pressing F8 on the keyboard repeatedly, you can look at the sheet to see what are and are.Offset(, -1).Resize(, 2) are, by seeing what's selected.

In the loop this line does the copying:
are.Offset(, -1).Resize(, 2).Copy Cells(2, colm)
where Cells(2, colm) is the top left cell of the destination being on the 2nd row and the colmth column.

Straight after the copying takes place, the line:
colm = colm + 2
increments the value of colm by 2 so that the next destination is 2 columns to the right of the last destination.
Next are marks the end of the loop, which goes on for as many times as there are areas in the non-contiguous range yyy.

The next line:
.Range("B2").RemoveSubtotal

removes the subtotals we added with the earlier line: Range("A1").Subtotal GroupBy:=1… but note it hasn't removed the inserted column A; this is done with the next line:
.Columns(1).Delete

The whole code above is surrounded above and below with :
With ActiveSheet
…
…
End With

which means that anything prefixed with a single dot, eg.
.Columns(1).Delete
actually means:
ActiveSheet.Columns(1).Delete

Which took longer than writing the code.