View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Ikaabod[_68_] Ikaabod[_68_] is offline
external usenet poster
 
Posts: 1
Default 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