![]() |
Splitting Cell content into separate Rows
I have a Spreadsheet that looks like the following,
Name Order Date Order John Smith 06/05/14 A,B,C,D Mike Doe 06/02/26 B,C,E and so on... with several thousand entries. I need the database to be structured in the following way. Name Order Date Order John Smith 06/05/14 A John Smith 06/05/14 B John Smith 06/05/14 C John Smith 06/05/14 D Mike Doe 06/02/26 B Mike Doe 06/02/26 C Mike Doe 06/02/26 E Is there any way that I can make this happen using a macro or applet of some sort? Does anyone have one that will do this already? Things to note are that all orders are currently separated by a comma followed by a single space, these must be removed. If anyone can help, thanks in advance. |
Splitting Cell content into separate Rows
It isn't pretty, but it works. Sub SplitSeparate() Application.ScreenUpdating = False Dim r As Integer, r2 As Integer Dim c As Integer, c2 As Integer r = 0 r2 = 0 c = 3 c2 = 0 Columns("C:C").Select Selection.TextToColumns Destination:=Range("C1") DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True Tab:=True, _ Semicolon:=False, Comma:=True, Space:=True, Other:=False FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)) TrailingMinusNumbers:= _ True Range("A2").Select Do Do If IsEmpty(ActiveCell.Offset(r, c)) = False Then r2 = r2 + 1 ActiveCell.Offset(r2, 0).EntireRow.Insert Range(ActiveCell.Offset(r, 0), ActiveCell.Offset(r, c)).Copy Range(ActiveCell.Offset(r2, 0).Address).PasteSpecial Range(ActiveCell.Offset(0, c).Address).Copy Range(ActiveCell.Offset(0, 2).Address).PasteSpecial Application.CutCopyMode = False c = c + 1 Else c = c + 1 r2 = r2 + 1 End If ActiveCell.Offset(-r2, -2).Activate Loop Until IsEmpty(ActiveCell.Offset(r, c)) = True r = r2 ActiveCell.Offset(r + 1, 0).Activate r = 0 r2 = 0 If c c2 Then c2 = c c = 3 Loop Until IsEmpty(ActiveCell) = True Range("D1", ActiveCell.Offset(0, c2 1).Address).EntireColumn.ClearContents Application.ScreenUpdating = True End Sub JokerFrowns Wrote: I have a Spreadsheet that looks like the following, . . . Is there any way that I can make this happen using a macro or apple of some sort? Does anyone have one that will do this already? Things to note are that all orders are currently separated by a comma followed by a single space, these must be removed. If anyone can help, thanks in advance -- Ikaabo ----------------------------------------------------------------------- Ikaabod's Profile: http://www.excelforum.com/member.php...fo&userid=3337 View this thread: http://www.excelforum.com/showthread.php?threadid=54252 |
Splitting Cell content into separate Rows
Many thanks,
I am no excel buff, do I just insert this into the code console and away I go? |
Splitting Cell content into separate Rows
In excel you can hit alt-F11, then click INSERT-MODULE and paste the code in there. You can run the code a number of ways (i.e. - create a command button that runs the macro, or manually run it in Microsoft VB Editor, etc.) Let me know if you have problems. JokerFrowns Wrote: Many thanks, I am no excel buff, do I just insert this into the code console and away I go? -- Ikaabod ------------------------------------------------------------------------ Ikaabod's Profile: http://www.excelforum.com/member.php...o&userid=33371 View this thread: http://www.excelforum.com/showthread...hreadid=542520 |
Splitting Cell content into separate Rows
There is one thing that needs changed actually. Change: ActiveCell.Offset(-r2, -2).Activate to If ActiveCell.Column < 1 Then ActiveCell.Offset(-r2, -2).Activate -- Ikaabod ------------------------------------------------------------------------ Ikaabod's Profile: http://www.excelforum.com/member.php...o&userid=33371 View this thread: http://www.excelforum.com/showthread...hreadid=542520 |
Splitting Cell content into separate Rows
I am getting an error compiling syntax in the following line:
Selection.TextToColumns Destination:=Range("C1"), Am I doing something wrong or forgetting something? |
Splitting Cell content into separate Rows
Ikaabod, I'm sure I was not explicit enough in my original issue...
Columns A through H are all single data entries that need to be repeated while it is Column I that contains the items separated by commas. Additionally there is a column J that contains data that is never to be repeated or split, as well as a column K that is to be repeated in the same manner as A through H for the database. Sorry if I was not specific in the first place, I wasn't expecting to have someone come out and give me such excellent help, nevermind code. Please help further if possible. |
Splitting Cell content into separate Rows
Let's try this one out: Sub Separate() Application.ScreenUpdating = False Dim i As Integer Dim rng As String, rng2 As String Dim MyStart As String MyStart = ActiveCell.Address Dim Sht As Worksheet Set Sht = ActiveSheet Sheets.Add.Name = "TempForm" Sht.Range("A:I").Copy Sheets("TempForm").Range("A1").PasteSpecial Sht.Range("K:K").Copy Sheets("TempForm").Range("I1").Insert Application.CutCopyMode = False Range("J:J").Select Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=True, Other:=False, FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True Dim rLast As Integer rLast = ActiveSheet.UsedRange.Rows.Count Range("K" & rLast).Select Do If IsEmpty(ActiveCell) Then ActiveCell.Offset(-1, 0).Activate Else ActiveCell.Offset(1, 0).EntireRow.Insert ActiveCell.Copy rng = ActiveCell.Address ActiveCell.Offset(1, -1).PasteSpecial Range(rng).Select Selection.Delete Range(ActiveCell.Offset(0, -10).Address, ActiveCell.Offset(0, -2).Address).Copy ActiveCell.Offset(1, -10).PasteSpecial Range(rng).Select End If Loop Until ActiveCell.Address = "$K$1" Range("I:I").Copy Range("L1").PasteSpecial Range("I1").EntireColumn.Delete Range("A:I").Copy Sheets(Sht.Name).Activate Range("A1").Select Selection.PasteSpecial xlValues Sheets("TempForm").Range("K:K").Copy Range("K1").Select Selection.PasteSpecial xlValues Application.DisplayAlerts = False Sheets("TempForm").Delete Application.DisplayAlerts = True Range(MyStart).Select Application.ScreenUpdating = True End Sub JokerFrowns Wrote: Ikaabod, I'm sure I was not explicit enough in my original issue... Columns A through H are all single data entries that need to be repeated while it is Column I that contains the items separated by commas. Additionally there is a column J that contains data that is never to be repeated or split, as well as a column K that is to be repeated in the same manner as A through H for the database. Sorry if I was not specific in the first place, I wasn't expecting to have someone come out and give me such excellent help, nevermind code. Please help further if possible. -- Ikaabod ------------------------------------------------------------------------ Ikaabod's Profile: http://www.excelforum.com/member.php...o&userid=33371 View this thread: http://www.excelforum.com/showthread...hreadid=542520 |
Splitting Cell content into separate Rows
Seems to be working great except for one minor issue which I think can
be solved by an integer count possibly... the datatable starting as: for example A B C D E F G H I J K 1 2 3 4 5 6 7 8 9i, 9ii, 9iii 10 11 a b c d e f g h ii,iii,iiii j k is being split in the following manner... A B C D E F G H I J K 1 2 3 4 5 6 7 8 9i 10 11 1 2 3 4 5 6 7 8 9ii j 11 1 2 3 4 5 6 7 8 9iii 11 a b c d e f g h ii k a b c d e f g h iii k a b c d e f g h iiii k When infact what I need it to be doing is... A B C D E F G H I J K 1 2 3 4 5 6 7 8 9i 10 11 1 2 3 4 5 6 7 8 9ii 11 1 2 3 4 5 6 7 8 9iii 11 a b c d e f g h ii j k a b c d e f g h iii k a b c d e f g h iiii k Is it possible to modify the code you just gave me to allow for this type of split? Otherwise it seems to be working exactly as needed. Once again, many many thanks for all the help. Ikaabod wrote: Let's try this one out: Sub Separate() Application.ScreenUpdating = False Dim i As Integer Dim rng As String, rng2 As String Dim MyStart As String MyStart = ActiveCell.Address Dim Sht As Worksheet Set Sht = ActiveSheet Sheets.Add.Name = "TempForm" Sht.Range("A:I").Copy Sheets("TempForm").Range("A1").PasteSpecial Sht.Range("K:K").Copy Sheets("TempForm").Range("I1").Insert Application.CutCopyMode = False Range("J:J").Select Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=True, Other:=False, FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True Dim rLast As Integer rLast = ActiveSheet.UsedRange.Rows.Count Range("K" & rLast).Select Do If IsEmpty(ActiveCell) Then ActiveCell.Offset(-1, 0).Activate Else ActiveCell.Offset(1, 0).EntireRow.Insert ActiveCell.Copy rng = ActiveCell.Address ActiveCell.Offset(1, -1).PasteSpecial Range(rng).Select Selection.Delete Range(ActiveCell.Offset(0, -10).Address, ActiveCell.Offset(0, -2).Address).Copy ActiveCell.Offset(1, -10).PasteSpecial Range(rng).Select End If Loop Until ActiveCell.Address = "$K$1" Range("I:I").Copy Range("L1").PasteSpecial Range("I1").EntireColumn.Delete Range("A:I").Copy Sheets(Sht.Name).Activate Range("A1").Select Selection.PasteSpecial xlValues Sheets("TempForm").Range("K:K").Copy Range("K1").Select Selection.PasteSpecial xlValues Application.DisplayAlerts = False Sheets("TempForm").Delete Application.DisplayAlerts = True Range(MyStart).Select Application.ScreenUpdating = True End Sub JokerFrowns Wrote: Ikaabod, I'm sure I was not explicit enough in my original issue... Columns A through H are all single data entries that need to be repeated while it is Column I that contains the items separated by commas. Additionally there is a column J that contains data that is never to be repeated or split, as well as a column K that is to be repeated in the same manner as A through H for the database. Sorry if I was not specific in the first place, I wasn't expecting to have someone come out and give me such excellent help, nevermind code. Please help further if possible. -- Ikaabod ------------------------------------------------------------------------ Ikaabod's Profile: http://www.excelforum.com/member.php...o&userid=33371 View this thread: http://www.excelforum.com/showthread...hreadid=542520 |
Splitting Cell content into separate Rows
Sub Separate() Application.ScreenUpdating = False Dim i As Integer Dim rng As String, rng2 As String Dim MyStart As String MyStart = ActiveCell.Address Dim Sht As Worksheet Set Sht = ActiveSheet Sheets.Add.Name = "TempForm" Sht.Range("A:K").Copy Sheets("TempForm").Range("A1").PasteSpecial Range("J1").EntireColumn.Copy Range("I1").EntireColumn.Insert Range("L1").EntireColumn.Copy Range("I1").EntireColumn.Insert Range("L:M").EntireColumn.Delete Range("K:K").Select Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=True, Other:=False, FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True Dim rLast As Integer rLast = ActiveSheet.UsedRange.Rows.Count Range("L" & rLast).Select Do If IsEmpty(ActiveCell) Then ActiveCell.Offset(-1, 0).Activate Else ActiveCell.Offset(1, 0).EntireRow.Insert ActiveCell.Copy rng = ActiveCell.Address ActiveCell.Offset(1, -1).PasteSpecial Range(rng).Select Selection.Delete Range(ActiveCell.Offset(0, -11).Address, ActiveCell.Offset(0, -3).Address).Copy ActiveCell.Offset(1, -11).PasteSpecial Range(rng).Select End If Loop Until ActiveCell.Address = "$L$1" Range("I:I").Copy Range("L1").PasteSpecial Range("J:J").Copy Range("L1").EntireColumn.Insert Range("I:J").EntireColumn.Delete Range("A:K").Copy Sheets(Sht.Name).Activate Range("A1").Select Selection.PasteSpecial xlValues Application.DisplayAlerts = False Sheets("TempForm").Delete Application.DisplayAlerts = True Range(MyStart).Select Application.ScreenUpdating = True End Sub JokerFrowns Wrote: Seems to be working great except for one minor issue which I think can be solved by an integer count possibly... the datatable starting as: for example A B C D E F G H I J K 1 2 3 4 5 6 7 8 9i, 9ii, 9iii 10 11 a b c d e f g h ii,iii,iiii j k is being split in the following manner... A B C D E F G H I J K 1 2 3 4 5 6 7 8 9i 10 11 1 2 3 4 5 6 7 8 9ii j 11 1 2 3 4 5 6 7 8 9iii 11 a b c d e f g h ii k a b c d e f g h iii k a b c d e f g h iiii k When infact what I need it to be doing is... A B C D E F G H I J K 1 2 3 4 5 6 7 8 9i 10 11 1 2 3 4 5 6 7 8 9ii 11 1 2 3 4 5 6 7 8 9iii 11 a b c d e f g h ii j k a b c d e f g h iii k a b c d e f g h iiii k Is it possible to modify the code you just gave me to allow for this type of split? Otherwise it seems to be working exactly as needed. Once again, many many thanks for all the help. -- Ikaabod ------------------------------------------------------------------------ Ikaabod's Profile: http://www.excelforum.com/member.php...o&userid=33371 View this thread: http://www.excelforum.com/showthread...hreadid=542520 |
Splitting Cell content into separate Rows
Thank you so much, you have made my life so much easier.
|
Splitting Cell content into separate Rows
Thank you so much, you have made my life so much easier.
|
Splitting Cell content into separate Rows
I will test this out on the actual data later on this evening and let
you know how it goes, I have only been testing it on test cases so far since the real data is on another machine. Hopefully it works. Thanks again. |
Splitting Cell content into separate Rows
Glad to help. I hope it works. If you have any issues let me know. Again, I know it's pretty ugly, but at the very least it should work :) Best of luck. JokerFrowns Wrote: I will test this out on the actual data later on this evening and let you know how it goes, I have only been testing it on test cases so far since the real data is on another machine. Hopefully it works. Thanks again -- Ikaabo ----------------------------------------------------------------------- Ikaabod's Profile: http://www.excelforum.com/member.php...fo&userid=3337 View this thread: http://www.excelforum.com/showthread.php?threadid=54252 |
All times are GMT +1. The time now is 04:50 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com