Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Reformat data from rows to columns
In column A, I have a unique value. In column B, I have a series of
additional values which are keyed to match the unique value in column A. Here is an example of what I have: COLUMN A COLUMN B RDK3173BK 14542 , 14567 , 16763 WSK3173AK 14644 , 16688 , 16789 , 16821 PCK3MOP 14638 , 16637 , 16815 , 14639 , 16638 , 16816 I need to convert the series of values in Column B to individual rows that still match Column A. Like this: COLUMN A COLUMN B RDK3173BK 14542 RDK3173BK 14567 RDK3173BK 16763 WSK3173AK 14644 WSK3173AK 16688 WSK3173AK 16789 WSK3173AK 16821 PCK3MOP 14638 PCK3MOP 16637 PCK3MOP 16815 PCK3MOP 14639 PCK3MOP 16638 PCK3MOP 16816 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Reformat data from rows to columns
Give this macro a try. It's non destructive as long as you use separate
sheets for the source (where your current data is) and destination (where we will put the revised data) sheets are different. Set those names up in the code below. It works with the sample data provided. Odd situations such as having just a "," for an entry in column B or ending an entry in column B with a "," could blow it up. Sub TransposeInGroups() 'destination sheet cannot be same as source sheet 'as currently written. Const destSheetName = "Sheet2" ' change as needed Const sourceSheetName = "Sheet1" ' change as needed Const firstSourceRow = 2 ' change if needed Const groupSeparator = "," Dim sepPosition As Integer Dim sourceListRange As Range Dim anySourceListEntry As Range Dim colBSource As String Dim anyNumber As String Dim destSheet As Worksheet Set destSheet = Worksheets(destSheetName) Set sourceListRange = Worksheets(sourceSheetName). _ Range("A" & firstSourceRow & ":" & _ Worksheets(sourceSheetName).Range("A" & Rows.Count). _ End(xlUp).Address) 'work through entries in column A For Each anySourceListEntry In sourceListRange colBSource = anySourceListEntry.Offset(0, 1).Text Do While InStr(colBSource, groupSeparator) 0 sepPosition = InStr(colBSource, groupSeparator) anyNumber = Trim(Left(colBSource, _ sepPosition - 1)) destSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = _ anySourceListEntry destSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = _ anyNumber colBSource = Right(colBSource, Len(colBSource) - sepPosition) Loop 'colBSource will still have last group in it destSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = _ anySourceListEntry destSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = _ Trim(colBSource) Next 'some housekeeping Set destSheet = Nothing Set sourceListRange = Nothing End Sub "autoguy" wrote: In column A, I have a unique value. In column B, I have a series of additional values which are keyed to match the unique value in column A. Here is an example of what I have: COLUMN A COLUMN B RDK3173BK 14542 , 14567 , 16763 WSK3173AK 14644 , 16688 , 16789 , 16821 PCK3MOP 14638 , 16637 , 16815 , 14639 , 16638 , 16816 I need to convert the series of values in Column B to individual rows that still match Column A. Like this: COLUMN A COLUMN B RDK3173BK 14542 RDK3173BK 14567 RDK3173BK 16763 WSK3173AK 14644 WSK3173AK 16688 WSK3173AK 16789 WSK3173AK 16821 PCK3MOP 14638 PCK3MOP 16637 PCK3MOP 16815 PCK3MOP 14639 PCK3MOP 16638 PCK3MOP 16816 . |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Reformat data from rows to columns
You should be able to do what you want using Split Function.
code below not fully tested but should place results from your sample data on new sheet - you can rename sheet references to suit but ensure destination sheet exists before running. Hope helpful Sub SplitColBValues() Dim ItemSplit As Variant Dim intIndex As Integer Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws1rn As Long Dim ws2rn As Long 'change sheet names as required Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws1rn = 1 ws2rn = 1 Do Until ws1.Range("A" & ws1rn).Value = "" ItemSplit = Split(ws1.Range("B" & ws1rn).Value, ",") For intIndex = LBound(ItemSplit) To UBound(ItemSplit) With ws2 .Range("A" & ws2rn).Value = ws1.Range("A" & ws1rn).Value .Range("B" & ws2rn).Value = ItemSplit(intIndex) End With ws2rn = ws2rn + 1 Next ws1rn = ws1rn + 1 Loop MsgBox "All Done!" End Sub -- jb "autoguy" wrote: In column A, I have a unique value. In column B, I have a series of additional values which are keyed to match the unique value in column A. Here is an example of what I have: COLUMN A COLUMN B RDK3173BK 14542 , 14567 , 16763 WSK3173AK 14644 , 16688 , 16789 , 16821 PCK3MOP 14638 , 16637 , 16815 , 14639 , 16638 , 16816 I need to convert the series of values in Column B to individual rows that still match Column A. Like this: COLUMN A COLUMN B RDK3173BK 14542 RDK3173BK 14567 RDK3173BK 16763 WSK3173AK 14644 WSK3173AK 16688 WSK3173AK 16789 WSK3173AK 16821 PCK3MOP 14638 PCK3MOP 16637 PCK3MOP 16815 PCK3MOP 14639 PCK3MOP 16638 PCK3MOP 16816 . |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Reformat data from rows to columns
This works really well, thank you very much!
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Reformat Data | Excel Programming | |||
reformat columns | Excel Discussion (Misc queries) | |||
Arrange data spanning 8 columns and 3 rows to 24 columns and 1 row | Excel Discussion (Misc queries) | |||
reformat excel to letters in columns | Excel Discussion (Misc queries) | |||
reformat columns to rows? | Excel Worksheet Functions |