![]() |
Re-structuring data
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 |
Re-structuring data
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 |
Re-structuring data
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 |
All times are GMT +1. The time now is 07:20 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com