Hi,

Have 2 columns with 250 rows. Each value in A has a B value.
There are 15 different B values.
I need to write a Macro which will create another worksheet,
headings for each B value will all the associated A values underneath.
Below is a sample, many thanks


How do I get from

A B
1 a
2 b
3 a
4 a
5 b
6 b
7 a
8 a
9 c
10 c
.........
.....

TO:
a
1
3
4
7
8

b
2
5
6


c
9
10


--
T De Villiers
------------------------------------------------------------------------
T De Villiers's Profile: http://www.excelforum.com/member.php...o&userid=26479
View this thread: http://www.excelforum.com/showthread...hreadid=530842

Hi,
This assumes data is sorted by column B then A with a header row.

Sub a()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, r As Long

Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
' assumes data sorted by column B then column A
With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
r = 2 '<===assumes there is header row
rr = 2
Do
n = Application.CountIf(Range("B:B"), .Cells(r, "B"))
.Cells(r, "B").Copy ws2.Cells(rr, "A")
.Cells(r, "A").Resize(n, 1).Copy ws2.Cells(rr + 1, "A")
r = r + n
rr = rr + n + 2
Loop Until r lastrow
End With
End Sub


HTH
"T De Villiers" wrote:


Hi,

Have 2 columns with 250 rows. Each value in A has a B value.
There are 15 different B values.
I need to write a Macro which will create another worksheet,
headings for each B value will all the associated A values underneath.
Below is a sample, many thanks


How do I get from

A B
1 a
2 b
3 a
4 a
5 b
6 b
7 a
8 a
9 c
10 c
.........
.....

TO:
a
1
3
4
7
8

b
2
5
6


c
9
10


--
T De Villiers
------------------------------------------------------------------------
T De Villiers's Profile: http://www.excelforum.com/member.php...o&userid=26479
View this thread: http://www.excelforum.com/showthread...hreadid=530842

Hi T

Try this:

Sub SortMe()
Dim sourcesht As Worksheet
Dim destsht As Worksheet
Dim destcell As Range
Dim rw As Integer
Dim val As Byte
Dim test As String
Set sourcesht = ActiveSheet
Worksheets.Add after:=Sheets(Sheets.Count)
Set destsht = ActiveSheet
Set destcell = destsht.Range("A1")

For val = 97 To 111
test = Chr(val)
destcell = test
Set destcell = destcell.Offset(1, 0)
For rw = 1 To 250
If sourcesht.Cells(rw, 2).Value = test Then

destcell = sourcesht.Cells(rw, 1).Value
Set destcell = destcell.Offset(1, 0)
End If
Next
Set destcell = destcell.Offset(1, 0)
Next
End Sub

Regards

Steve