View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.misc
Philipgrae Philipgrae is offline
external usenet poster
 
Posts: 6
Default Parsing, separating, inserting. copying

Hi all,

I have a challenge with a worksheet that contains a column of
delimited data, which needs separating and adding to new rows in the
column. The delimiter is ";#"
For example:

Col A Col
B Col C Col D
Row 1 02/06/09 Fred
Apples;#Pears;#Bananas text
Row 2 03/06/09 Emma
Oranges;#Pears text
Row 3 04/06/09 George
Oranges text

I have a brilliant script written by Tom Ogilvy that I found on here
which parses and separates the data like this......

Col A Col
B Col C Col D
Row
1
Apples
Row
2
Pears
Row 3 02/06/09 Fred
Bananas text
Row
4
Oranges
Row 5 03/06/09 Emma
Pears text
Row 6 04/06/09 George
Oranges text

However I need the rest of the data in the row from whence the
deliminated data came to be repeated by the muber of elements in the
delimited string (ie the number of rows inserted by the macro). Please
note the code inserts these rows above the original.

This example is just that... in the real thing the delimited data is
in Column AA, and the data extends from Column A to Column AB.

I've pasted Tom's code below in the hope anyone can amend it to solve
my problem - I have tried to do it myself but it's pushing the edge my
VBA envelope a bit too far!

Many thanks in anticipation,

Phil

Function Split(sStr As Variant, sdelim As String) As Variant
Split = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function


Sub testme()
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim wks As Worksheet
Dim mySplit As Variant
Dim myStr As String
Dim NumberOfElements As Long


Set wks = Worksheets("sheet1")


With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row


For iRow = LastRow To FirstRow Step -1
myStr = .Cells(iRow, "AA").Value
If Len(myStr) 0 Then
mySplit = Split(myStr, ";#")
NumberOfElements = UBound(mySplit) - LBound(mySplit) +
1
If NumberOfElements 1 Then
.Cells(iRow, "AA").Resize(NumberOfElements - 1) _
.EntireRow.Insert
.Cells(iRow, "AA").Resize(NumberOfElements).Value
_
= Application.Transpose(mySplit)
End If
End If
Next iRow
End With


End Sub