Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,203
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,069
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Reformat data from rows to columns

This works really well, thank you very much!
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Reformat Data Jcraig713 Excel Programming 2 September 4th 09 03:58 PM
reformat columns CandiC Excel Discussion (Misc queries) 2 August 28th 09 10:38 PM
Arrange data spanning 8 columns and 3 rows to 24 columns and 1 row pfdino Excel Discussion (Misc queries) 2 March 19th 07 09:03 PM
reformat excel to letters in columns KENNETH WEINER Excel Discussion (Misc queries) 4 March 15th 07 03:51 PM
reformat columns to rows? RickyDee Excel Worksheet Functions 1 October 11th 05 09:05 PM


All times are GMT +1. The time now is 07:43 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"