PDA

View Full Version : Create new line for each slash in field



simonstaton
10-29-2012, 12:50 PM
Hi,

I have a complicated problem that I have spent hours on with no use so have decided to turn to experts for help. I need a vba script to convert the following:

- sku - category - price -
- 103 - dog/test/test2 - 50 -
- 104 - dog/test/test5 - 60 -

into:

-sku - category - price -
- 103 - [blank] - 50 -
- [blank] - dog - [blank] -
- [blank] - dog/test - [blank] -
- [blank] - dog/test/test2 - [blank] -
-104 - [blank] - 60 -
- [blank] - dog - [blank] -
- [blank] - dog/test - [blank] -
- [blank] - dog/test/test5 - [blank] -

So seperating the "category column" into individual lines but keeping the root category for each section there and making a new line for each. So making one line of "dog/test/test2" into 4 lines of "[blank] - dog - dog/test - dog/test/test2" confusing I know! And also making all data on the new category lines blank but keeping the original lines data just making the original category field blank.

Again been going mad over this, the lines are around 23000 so doing this manually is no a go, you guys are my only hope now.

An image of my actual data is here:
http[space]://i45[dot]tinypic[dot]com/4gjbes.jpg

A bit more info: there are more columns but did 3 to make it simple, the category is on column "E" and again there are 23000 lines. The sheet is called "testdata" I also have a script here that does sort of what I need to but it is only making new lines and not doing the above:


Sub test()
Dim a, i As Long, ii As Long, e, n As Long
Dim b(), txt As String, x As Long
With Range("a1").CurrentRegion
a = .Value
txt = Join$(Application.Transpose(.Columns(3).Value))
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "/"
x = .Execute(txt).Count * 2
End With
Redim b(1 To UBound(a, 1) + x, 1 To UBound(a, 2))
For i = 1 To UBound(a, 1)
If a(i, 3) <> "" Then
For Each e In Split(a(i, 3), "/")
n = n + 1
For ii = 1 To UBound(a, 2)
b(n, ii) = a(i, ii)
Next
b(n, 3) = Trim$(e)
Next
End If
Next
.Resize(n).Value = b
End With
End Sub


Thankyou for any advice!
Simon

magelan
10-29-2012, 01:14 PM
I would greatly simplify your code.

use a for loop to go through b2 and split by /. if a split exists, insert a new row and format your output appropriately.

EDIT:

Please go through and name your varaibles something aside from LETTERS!!!

Letters are only acceptable for FOR LOOP COUNTERS! even then if you have more than I J P R you should go through and rename your for counters as actual words so you know what youre counting.

simonstaton
10-29-2012, 01:17 PM
I would greatly simplify your code.

use a for loop to go through b2 and split by /. if a split exists, insert a new row and format your output appropriately.

EDIT:

Please go through and name your varaibles something aside from LETTERS!!!

Letters are only acceptable for FOR LOOP COUNTERS! even then if you have more than I J P R you should go through and rename your for counters as actual words so you know what youre counting.

Thankyou so much for the reply, on the verge of thinking this is lost cause :(. I I don't have any experience with vba so those words are a bit over my head would it be possible for you to reedit my code? In the dark a bit on this one as I am just a web developer and have only used vba once before

magelan
10-29-2012, 01:30 PM
Thankyou so much for the reply, on the verge of thinking this is lost cause :(. I I don't have any experience with vba so those words are a bit over my head would it be possible for you to reedit my code? In the dark a bit on this one and have got quite a lot on the line for me to find a fix :O

edit: I got the code from a post a found, it does something along the lines of what I want but did not write it

I'm working on a code for this right now that you would be able to just change the values in and have it do what you want [since it intrigued me and i will probably need something like this soon]

basically...all those variables named "i" and "ii" and "p" and "r" are what I like to refer to as indian code... all of the coders I know that learned in india dont make their code viewer friendly because it was never taught to them. To make it more readable to yourself and others you should rename those variables and find-replace them to make the code understandable [depending on if you know what they are]

since you didnt write the code i'm guessing you dont know what each variable does so dont worry about it, but let me try and get this code block done for you.

simonstaton
10-29-2012, 01:33 PM
I'm working on a code for this right now that you would be able to just change the values in and have it do what you want [since it intrigued me and i will probably need something like this soon]

basically...all those variables named "i" and "ii" and "p" and "r" are what I like to refer to as indian code... all of the coders I know that learned in india dont make their code viewer friendly because it was never taught to them. To make it more readable to yourself and others you should rename those variables and find-replace them to make the code understandable [depending on if you know what they are]

since you didnt write the code i'm guessing you dont know what each variable does so dont worry about it, but let me try and get this code block done for you.

Fantastic, thankyou and yes I can understand I am a web developer so always try and name my variables in stuff like javascript so they are easily followed and referenced. might have to start learning vba looks very interesting

Also to make things even more complicated for you :) just realised one of the categorys is "puppy / adult" with a space at either side of the "/" to say it is not a category but actually the name of one, is it possible to not count the "/" if it has a space at either side? Thankyou again

Also if you want to see what the actual data looks like you can see it here: http[space]://i45[dot]tinypic[dot]com/4gjbes.jpg

magelan
10-29-2012, 01:36 PM
Fantastic, thankyou and yes I can understand I am a web developer so always try and name my variables in stuff like javascript so they are easily followed and referenced. might have to stop learning vba looks very interesting

i am actually very new to VBA myself [started in september] but have been coding some major full on programs for a company now.. learning a lot and definitely learning its limitations. VBA can be fun though - just to see what you can do

simonstaton
10-29-2012, 01:51 PM
i am actually very new to VBA myself [started in september] but have been coding some major full on programs for a company now.. learning a lot and definitely learning its limitations. VBA can be fun though - just to see what you can do

I see, well this stupidly complicated script should be a test of your skills :)

Also here is what it should be doing for each line: http:[SPACE]//i50[DOT]tinypic.com/4rc5m1[DOT]jpg

magelan
10-29-2012, 02:15 PM
Option Explicit
Sub splitEmUp()
Dim splitter() As String 'this is storage space for the split function
Dim i As Integer ' main-loop for counter "which cell we are on"
Dim j As Integer ' splitter for-loop counter "which section of the split are we on"
Range("b2").Activate 'starting in cell b2 because row 1 is headers and category is located in the B column

For i = 0 To 50 'from beginning to end i=0 means b2, i=1 means b3
splitter = Split(ActiveCell.Offset(i, 0), "/") 'split the cell based on / and store it in splitter
If (UBound(splitter)) > 0 Then 'if a split occurred
ActiveCell.Offset(i, 0).Value = "" 'set the activecell to blank
ActiveCell.Offset(i + 1, 0).EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove 'insert a new row and shift everything down

ActiveCell.Offset(i + 1, 0).Value = splitter(0) 'initialize the "Down" cells

For j = 1 To UBound(splitter)
ActiveCell.Offset(i + j + 1).EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove 'create another row if it needs to
ActiveCell.Offset(i + (j + 1), 0).Value = ActiveCell.Offset(i + j).Value & "/" & splitter(j) 'fill out the new row
Next
i = i + UBound(splitter) + 1 'need to step I past the new cells
ReDim splitter(0)
Erase splitter 'erase and eliminate splitter to avoid carry over.

End If
Next

End Sub


of course like i said you will need to change the variable ranges in this [or make functions that dynamically get the variable range - HOHO!!!] but as it stands this will find everything in Column B that is a / and step it out.

simonstaton
10-29-2012, 02:17 PM
Option Explicit
Sub splitEmUp()
Dim cells As Range
Set cells = Range("A2:C500") 'the range you are trying to hit skipping headers
Dim cellVar As Range
Set cellVar = Range("B2") 'this will be the currently modified cell skipping headers to start at first real cell
Dim splitter() As String 'this is storage space for the split function
Dim i As Integer ' main-loop for counter "which cell we are on"
Dim j As Integer ' splitter for-loop counter "which section of the split are we on"
Range("b2").Activate 'starting in cell b2 because row 1 is headers and category is located in the B column

For i = 0 To 50 'from beginning to end i=0 means b2, i=1 means b3
splitter = Split(ActiveCell.Offset(i, 0), "/") 'split the cell based on / and store it in splitter
If (UBound(splitter)) > 0 Then 'if a split occurred
ActiveCell.Offset(i, 0).Value = "" 'set the activecell to blank
Debug.Print i
ActiveCell.Offset(i + 1, 0).EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove 'insert a new row and shift everything down

ActiveCell.Offset(i + 1, 0).Value = splitter(0) 'initialize the "Down" cells

For j = 1 To UBound(splitter)
ActiveCell.Offset(i + j + 1).EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove 'create another row if it needs to
ActiveCell.Offset(i + (j + 1), 0).Value = ActiveCell.Offset(i + j).Value & "/" & splitter(j) 'fill out the new row
Next
i = i + UBound(splitter) + 1 'need to step I past the new cells
ReDim splitter(0)
Erase splitter 'erase and eliminate splitter to avoid carry over.

End If
Next

End Sub



Fantastic, worked a dream. Seemed to stop on the 50th line though, any way to increase it to 24000?

Edit: just figured it out, changed the to 50. Hands down you are doing very good for one month learning! Thanks again really appreciated :)

magelan
10-29-2012, 02:20 PM
Fantastic, worked a dream. Seemed to stop on the 50th line though, any way to increase it to 24000?

I've edited my code above and taken out some unnecessary things.

As a student to VBA you should be able to look at my code and see where it needs to be changed in order to give you full range to 24000 - I labeled everything pretty well for you!

Hint - its the big loop that drives everything

simonstaton
10-29-2012, 02:22 PM
I've edited my code above and taken out some unnecessary things.

As a student to VBA you should be able to look at my code and see where it needs to be changed in order to give you full range to 24000 - I labeled everything pretty well for you!

Hint - its the big loop that drives everything

Yes have managed to figure it out, the notes are very helpful just going over how it works now. Now for the complicated bit! :P is there anyway to have it ignore the "/" if it has a space at either side so " / " = not a new line but "/" = new line

Just brainstorming now how I could do this, would an if statement work? I imagine you have these in vba? So if charecter = " / " ignore; if charecter = "/" do this

magelan
10-29-2012, 02:28 PM
Yes have managed to figure it out, the notes are very helpful just going over how it works now. Now for the complicated bit! :P is there anyway to have it ignore the "/" if it has a space at either side so " / " = not a new line but "/" = new line
BTW - If you didnt, copy my new code from above - I changed it right after I posted it because I noticed some parts I thought i was going to use but didnt.

In order to add that functionality, I think the best thing to do would be to add a filter in - basically an if statement.

Enclose the entire For loop in an if-statement that utilizes the instring functions. It would look like


If (instr(activecell.offset(i,0).value," / ") = 0 then
for.....
....
...
end if


Note- however - that this code will ignore lines that look like "var/text / spaced" as well as lines that look like " var / spaced"

If you need stuff that has "var/text / spaced" then i will have to build something a little more complicated [character substitution!]

simonstaton
10-29-2012, 02:30 PM
BTW - If you didnt, copy my new code from above - I changed it right after I posted it because I noticed some parts I thought i was going to use but didnt.

In order to add that functionality, I think the best thing to do would be to add a filter in - basically an if statement.

Enclose the entire For loop in an if-statement that utilizes the instring functions. It would look like



If (instr(activecell.offset(i,0).value," / ") = 0 then
for.....
....
...
end if


Note- however - that this code will ignore lines that look like "var/text / spaced" as well as lines that look like " var / spaced"

If you need stuff that has "var/text / spaced" then i will have to build something a little more complicated [character substitution!]

Okay have done and will give this a go, so it will jump the entire field if it has " / " in not just ignore that part of the field?

magelan
10-29-2012, 02:32 PM
Okay have done and will give this a go, so it will jump the entire field if it has " / " in not just ignore that part of the field?

It will jump the entire field, yes. We can build something in if you want it to still separate /'s while keeping " / "'s in the same field.

simonstaton
10-29-2012, 02:34 PM
It will jump the entire field, yes. We can build something in if you want it to still separate /'s while keeping " / "'s in the same field.

If we could that would be good, so making: /test/test2/test / tests into:

/test
/test/test2
/test/test2/test / tests

magelan
10-29-2012, 02:39 PM
If we could that would be good, so making: /test/test2/test / tests into:

/test
/test/test2
/test/test2/test / tests
We need to use character substitution then - i will replace all " / " with "!@#" and then replace them back when we are done. Check it out!


Option Explicit
Sub splitEmUp()
Dim splitter() As String 'this is storage space for the split function
Dim i As Integer ' main-loop for counter "which cell we are on"
Dim j As Integer ' splitter for-loop counter "which section of the split are we on"
Range("b2").Activate 'starting in cell b2 because row 1 is headers and category is located in the B column

For i = 0 To 50 'from beginning to end i=0 means b2, i=1 means b3
ActiveCell.Offset(i, 0).Value = Replace(ActiveCell.Offset(i, 0).Value, " / ", "!@#")
splitter = Split(ActiveCell.Offset(i, 0), "/") 'split the cell based on / and store it in splitter
If (UBound(splitter)) > 0 Then 'if a split occurred
ActiveCell.Offset(i, 0).Value = "" 'set the activecell to blank
Debug.Print i
ActiveCell.Offset(i + 1, 0).EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove 'insert a new row and shift everything down

ActiveCell.Offset(i + 1, 0).Value = splitter(0) 'initialize the "Down" cells
ActiveCell.Offset(i + 1, 0).Value = Replace(ActiveCell.Offset(i + 1, 0).Value, "!@#", " / ")
For j = 1 To UBound(splitter)
ActiveCell.Offset(i + j + 1).EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove 'create another row if it needs to
ActiveCell.Offset(i + (j + 1), 0).Value = ActiveCell.Offset(i + j).Value & "/" & splitter(j) 'fill out the new row
ActiveCell.Offset(i + (j + 1), 0).Value = Replace(ActiveCell.Offset(i + (j + 1), 0).Value, "!@#", " / ")
Next
i = i + UBound(splitter) + 1 'need to step I past the new cells
ReDim splitter(0)
Erase splitter 'erase and eliminate splitter to avoid carry over.

End If
Next

End Sub


Time for me to head home though!
http://www.vbaexpress.com/forum/data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAWQAAAFLCAIAAABug2GUAAAUhUlEQVR4nO2dS5Kj ShJF2Ra5ILZDrqCXwTLaetYDTfvN3vwN6QEI4kekFxJKv8E5FlZWUupDyi9HAcpwdf/7+5///f3Pv6Z/z8r8579//fYmgDzqKbp6+ztkAbCgniJkYUK9zOAB9RQhCxPqZQYPqKcIWZhQLzN4QD1FHmTxGPtumC7djFdR LzN4QD1FyMLEiZdJ4LeCz3IiRdPQdf34uGJr/hxkYQJZwOsws6hTkMVj7LuVxZnBbrWLNN7XpuF3/Rq9TMEvsG5hek1weX9jCK8MLDINXUj+iPuNp6Hrx3G5/TAM4cM8xt7POxCUCVL0GPt+fGy130oXlXha0rFVOQ/eUagu3/5LyGRReMN9XhVNudzKItzKaejHx/rvPMe7bPKLhlUPbrb/YsHtH2OfxGG5sGTr+YODRwS3xLLYHXFY4qjIefA+HYFfkUVii8fYd8OY/K5eZRGpPiPZ46P3hPAXeP4+4Y223zH16faD5Ln3ixzySJDIIi5lscTB5Tx4R6G6jN84Z/GcOmXzcxFZZFsSHXUcyiJhC8c+xziIxfZIRz/AFRpUZVEucZSKJHiHofrA9l9C5QTn9jqsL1wsSseySHbMdC54JIvS7hzVu/Agzycov+2st8QVIlwws/ho3X9RFtvvGv2ncEgeHd/9DrVzFslhZSiL2H2F32AaSuXOzllkk4/olp84twVvoHbO4qDE1XMWnz5T9XFZhCf/C+/B8Suy3c7PzGIOpwNBhdfL4xDt5cWjreja6MOQ/XcMro6vLJwcxhUiZDOLIOHr9RVZFIJ3FKrrt/8S+HPvGslbwxkl1k+4gieOD0M0QBYmLnqZ4j39zKwSVwiBLOogizrFP9+ygyuUQBZ1kAXAinqKL pfFv6Z/L+M///2LwWAwjgYzC4AV9RRdvf3IAmBFPUXIwoR6mcED6ilCFibUywweUE8RsjChXmbwgHqKkIUJ9TKDB 9RTdBdZFBajFfoOHVypX2bwgFCKios37yCLZXHalK3DCNeB7QuEsyvnWarM4BaRFBX3l3m+hywW 4pUX2Wq+YsPD7YJImcE1UikqrFS6qSyKzSYqHSikygxOkUoRsijLYl0bXlkwLlVmcIpUipAFMwv 4PaRShCw4ZwG/h1SKkEX8aUjQ3DBrihp3ipAqMzhFKkU3lUXynV/RV7ukTWeKV4qVGZwikqKD/eUesngDImUG16inCFmYUC8zeEA9RcjChHqZwQPqKUIWJtTLDB5QT9HlsqAHJ4PBsAxmFgAr6im6 evuRBcCKeoqQhQn1MoMH1FOELEyolxk8oJ4iZGFCvczgAfUUIQsT6mUGD6inCFmYUC8zeEA9Rcj ChHqZwQPqKUIWJraXKV65HizjLbQFn4auH8chaxUONwVZ1GlNFpEtdldMw3Mdb+CPZakvmoAVZF GnOVkEtii0B5nDDlvxLARuD7Ko054sNgdEffeCo5Cu0HcLAFn8RIOyWC0RuiI9NkEWUABZ1GlRF svxRx/MK5LencgCSiCLOk3KYj3oCEWw9S3sx3FAFlACWdRpUxYAJ1BPEbIwoV5m8IB6ipCFCfUygwfUU4 QsTKiXGTygnqLLZUEPTgaDYRnMLABW1FN09fYjC4AV9RQhCxPqZQYPqKcIWZhQLzN4QD1FyMLEe 18m/rTzniCLOsgiB1fcFGRRB1lkTEMXdso5pY3Td4RfBFnUQRYpgSuQxb1AFnVak8XLPTg3V0TtcsKp Rvow0bX9+CjeEQRAFnVak8WrPTjDeUU2QSg/dmkWwcxCEWRRpzlZvNSDM71H1pkv/OHTK4+xz06IIgtFkEWd9mTxQg/OzC6Vhygenbx+sgN+EWRRp0FZnO7Bme/hmSzqAognNchCDWRRp0VZnOzBWdjB46lG+bAmuXntCAh8gyzqNCmLUz04i5OB9PgiPhR5njxNj2 8KdwQBkEWdNmVxAg4cAFnUQRYLuAKQxQ8gC4AV9RQhCxPqZQYPqKfoclnQg5PBYFgGMwuAFfUUX b39yAJgRT1FyMKEepnBA+opQhYm1MsMHlBPEbIwoV5m8IB6ipCFCfUygwfUU3QXWSxrKbL14VlT quIt9csMHlBJUblf2z1kMQ1d149TvFBzufIR/7d4y3nWKTN4RiNFj7GP1jXuuriDLBbiVd3RitBk4UZh/bdGmcE3eimKd4WbyqLaSAJZwCXopSjusoAs5rnURhdZwNtRS1G6IyCL7BKygGvQSlFwVm/lprLgnAV8HqEU5aaY7yuLtG1m+uEpsoC3I5Kix9iX+zXeQRZhE8ugb+X+afL2whzcUqbM4BqNFK U7wf5OegdZvAGNMoNv1FOELEyolxk8oJ4iZGFCvczgAfUUIQsT6mUGD6in6HJZ0IOTwWBYBjMLg BX1FF29/cgCYEU9RcjChHqZwQPqKUIWJtTLDB5QTxGyMKFeZvCAeoqQhQn1MoMH1FOELEyolxk8oJ4iZGFC vczgAfUUIQsT28sUL2cPFrMXeoVPQ9eP45A1SYabgizqtCaLyBa7K6YhbIgcdA1HE7CBLOo0J4v AFoUmOXPYdittqgM3B1nUaU8WmwOiZnzh97J0yAJKIIs6DcpitUToivTYBFlAAWRRp0VZLMcffT CvSBp6IgsogSzqNCmL9aAjFMHWuLAfxwFZQAlkUadNWQCcQD1FyMKEepnBA+opQhYm1MsMHlBPE bIwoV5m8IB6ii6XBT04GQyGZTCzAFhRT9HV248sAFbUU4QsTKiXGTygniJkYUK9zOAB9RQhCxPv fZn40857gizqIIucA1dMQ2HBOzQEsqiDLDKOpIAsWgdZ1EEWKYdOQBatgyzqtCaLl3twxkrY79W PY/iTsJlOcMiyLW7NfgL+QRZ1WpPFqz04p9QIz0vT0HWReMIn2de8B7fAFGogizrNyeKlHpzxPZI9f lNBaoLnD5LeXByzqIEs6rQnixd6cCZ2SX6+7f/p/bYn2g3Bh6+KIIs6DcridA/OdMZwZmbB6QphkEWdFmVxsgdnfp5hGuLTFIfnLLYZB4pQBlnUaVIWp3pwFs9J7pOFYXqM/X6MEnzskRy4lK4HCZBFnTZlcYLXP7/Iz3igCy2QRR1ksfCGzzoP/8QDREAWdZDFG4nOcGIKOXyk6DzIwoR6mcED6im6XBb04GQwGJbBzAJgRT1FV28/sgBYUU8RsjChXmbwgHqKkIUJ9TKDB9RThCxMqJcZPKCeImRhQr3M4AH1FN1FFtFCrfCqeAnnQYM q+TKDB1RSVNoz5vkeslgWd055M4mgOcRzDXjY8Cp4pVTKDJ4RSdHe9i1ZN30HWSzEiymil6G0cC O+uUiZwTVyKUoWIN1UFnl/u3SpRSxVuTKDQ9RSFMy+53lGFgvZcu9UH2plBo/IpGjrmxLPt5FFdik3qlCZwTFyKfrwmTunsqics8hNMQuWGRyil6LPnrnzKou0bebe3L/YKEKvzOAPjRQ9xr7wnTXzfA9ZJF/jlX+HWPRFP8Wv/NIoM/hGJEXhHxtF75x3kMUbECkzuEY9RcjChHqZwQPqKUIWJtTLDB5QTxGyMKFeZvCAeooulwU9OBkMh mUwswBYUU/R1duPLABW1FOELEyolxk8oJ4iZGFCvczgAfUUIQsT6mUGD6inCFmYUC8zeEA9RcjChHqZwQPqKU IWJtTLDB5QTxGyMLG9THG3vWDZe6Ej8jR0/TgOhZZDcEuQRZ3WZBHZYnfF3hA58Mey4h1NwAqyqNOcLJJWOXmnnL3tVtJIHe4OsqjTniw2B0TN +MKGIR2ygBLIok6DslgtEboiPTZBFlAAWdRpURbL8UefNPkNGnoiCyiBLOo0KYv1oCMUwda+sx/HAVlACWRRp01ZAJxAPUXIwoR6mcED6ilCFibUywweUE8RsjChXmbwgHqKLpcFPTgZDIZlMLMAWF FP0dXbjywAVtRThCxMqJcZPKCeImRhQr3M4AH1FCELE+99mfjTznuCLOogixxccVOQRR1kkTENh S4YVaLF8CALsqiDLFL+3BXIohGQRZ3WZPFyD87YFfm90muirjp/ahlwBbKo05osXu3BGbliGvb9f3mE4uMws2gEZFGnOVm81IMzvkf9RGdgCGTRBsiiTnuyeKEHZ2K X0tmL0uMgi0ZAFnUalMXpHpzpPp/PLMqPgywaAVnUaVEWJ3tw5rt8ds6i/DgHxzugBrKo06QsTvXgLE4P9qOO6KRo/Dj7zTCGNMiiTpuyOAGHEoAs6iCLBVwByOIHkAXAinqKkIUJ9TKDB9RTdLks6MHJYDAsg5kFwIp6 iq7efmQBsKKeImRhQr3M4AH1FCELE+plBg+opwhZmFAvM3hAPUXIwoR6mcED6im6iyyW1RXR2op Cb6vidfOsX2bwgFaKlmVK4S5zB1ksizunrJlEuHgrbXiVrBjVKjP4RClF09D1w9DfThYLlS5VhY UbyapwpTKDV3RStLdsQRaJC/J+EWGniXlWKjP4RSVFzzdPZJFfCBvcbf0k4pmGSpnBMxop2ufZyCK/UOpE9Rj7UBgaZQbfKKQoPCRHFgs/nbNIbq5QZvCOQoq2qXXAcz+4qyzStpnPL/SJGtkxs4B3opaiO84sUllm3yEWHZ0Uv/1LrczgEbUU3VEWb0CtzOAR9RQhCxPqZQYPqKcIWZhQLzN4QD1FyMKEepnBA+opulwW9OBkMBiWw cwCYEU9RVdvP7IAWFFPEbIwoV5m8IB6ipCFCfUygwfUU4QsTKiXGTygniJkYUK9zOAB9RQhCxPq ZQYPqKcIWZhQLzN4QD1FyMLE9jLFjXyDZXmFvuDT0PXjOBQab8EtQRZ1WpNFZIvdFXtb8MAfy9J 4NAEryKJOc7IIbFHoxjeHbbeSrxOAu4Ms6rQni80BUTO+sG1OhyygBLKo06Asgi9VCM5ORMcmyA IKIIs6LcpiOf7og3lF0tATWUAJZFGnSVmsBx2hCLY+n/04DsgCSiCLOm3KAuAE6ilCFibUywweUE8RsjChXmbwgHqKkIUJ9TKDB9RTdLks6MHJYDAsg5kFw Ip6iq7efmQBsKKeImRhQr3M4AH1FCELE+plBg+opwhZmHjvy8Sfdt4TZFEHWeRsrojWrZ58pHyN PHgFWdRBFhn7Hn4oi2noTBZAFlIgizrIIiXYwZlZ3AtkUac1WbzcgzPcvxdZBAtWH3P2LNmD7E/UjyOyUAJZ1GlNFq/24IzmAst+H9omaIoR9seIO3I9H2AaOtvRCvgAWdRpThYv9eBM7pEchuwiSWQRT2WK9wABkEWd9m TxQg/O1C75rp/fM36Q5CGRhRTIok6DsjjdgzM7n8nM4l4gizotyuJkD878s4/snEV4NqIoi/BD1ejeIACyqNOkLE714Cx8TvoY+36ctgOY4tFG8VjmefvH2CMLHZBFnTZlcYKX/6YC5EEWdZDFAq4AZPEDyAJgRT1FyMKEepnBA+opulwW9OBkMBiWwcwCYEU9RVdvP7IAWFFPEbIw oV5m8IB6ipCFCfUygwfUU4QsTKiXGTygniJkYUK9zOAB9RTdRRaFVVeF3lYry0KP8MbqZQYPiKS o1G5hnud7yGJZqTnFzSSC5ZtJe9xp6Pph6JEFvBmRFB0uTbiDLBbizjPRYs7w1dmbVSALeC8iKU IWsSxiGeyXnq8TsoD3I5Ki8DAkOnBHFvO8dZzalYos4P3IpShsIj0ji+DSlByMIAt4L4Ipig7Xb yqL0jmLrdlVwPMOgmUGd+ilKN5p7iqLauc6ZhZwBRIp2r8CJ/uc8A6ySKcM2XeIlb/8A1nAe9FIUbi7xHvGHWTxBjTKDL5RTxGyMKFeZvCAeoqQhQn1MoMH1FOELEyolxk8oJ6iy2VBD0 4Gg2EZzCwAVtRTdPX2IwuAFfUUIQsT6mUGD6inCFmYUC8zeEA9RcjChHqZwQPqKUIWJtTLDB5QT xGyMKFeZvCAeoqQhQn1MoMH1FOELExsL1O8nD1YnFroFT4NXT+OQ6l/ONwRZFGnNVlEtthdsTcBCPyxrPVFE7CCLOo0J4vAFmnTi4W9kWehqQ7cGWRRpz1ZbA6IOqaXvpg FWUAEsqjToCyCrxYJzk4kXzySXguALH6gRVksxx99MK9IGnoiCyiBLOo0KYv1oCMUwda4sB/HAVlACWRRp01ZAJxAPUXIwoR6mcED6ilCFibUywweUE8RsjChXmbwgHqKLpcFPTgZDIZlMLMAWF FP0dXbjywAVtRThCxMqJcZPKCeImRhQr3M4AH1FCELE+99mT7zp538Aak3kEUdZJGz7cWP76/Xdudp6L6+0zXy6bOcuC9cArKogywy9r30UBbT0Jn25MoO/6MLkMXHQRZ1kEVKsJNeOLP4WQXI4uMgizqtySLpwfn9Fc4S8h6cX9/fSQ/OcB9dZLEtWN333XjJe/wg+xN9fX8f7fAHJji8b7D1ob62Tct+AidAFnVak0Xc52ZzxTSEs4X1/6UenFO+i4a2CZpihP0xgo5c+8MvPyrKouyKo/uGzxxeMBwvwZ+ALOo0J4uwB2ew8+3sO1Z+ijG5R7IP7jtnIot4KlO8R+VZfrpvaoLnD8LrOWZ5B 8iiTnuy2HtwhjtZOI8/7JSV7sX57pvfM36Q5CGL+/CBKw7vm27mtlVFecF5kEWdBmWx7k3JG280jy/LIpvMXzKzODxkODOz4HTFO0EWdVqUxfLe/RXsYqYenPlenJ2zCM8oFGURfqga3bvyLD/eNztnsc04UMRbQRZ1mpTFuq8Ve3B+fX+Xe3AW9uLH99fX97S9gRePNorHMs/bP76/ElnUT0Ue3jf42CN4wOjDEM5ZvAyyqNOmLE7wmQ8U3vgsyakPTnG+DrKogywW5Fxx/BclcBZkUQdZ6BKd4cQUr6OeImRhQr3M4AH1FF0uC3pwMhgMy2BmAbCinqKrtx9ZAKyopwhZmFAv M3hAPUXIwoR6mcED6ilCFibUywweUE8RsjChXmbwgHqKkIUJ9TKDB9RThCxMqJcZPKCeImRhQr3 M4AH1FCELE+plBg+opwhZmFAvM3hAPUVXb///Aaf7O97L5RxpAAAAAElFTkSuQmCC

simonstaton
10-29-2012, 02:41 PM
We need to use character substitution then - i will replace all " / " with "!@#" and then replace them back when we are done. Check it out!



Option Explicit
Sub splitEmUp()
Dim splitter() As String 'this is storage space for the split function
Dim i As Integer ' main-loop for counter "which cell we are on"
Dim j As Integer ' splitter for-loop counter "which section of the split are we on"
Range("b2").Activate 'starting in cell b2 because row 1 is headers and category is located in the B column

For i = 0 To 50 'from beginning to end i=0 means b2, i=1 means b3
ActiveCell.Offset(i, 0).Value = Replace(ActiveCell.Offset(i, 0).Value, " / ", "!@#")
splitter = Split(ActiveCell.Offset(i, 0), "/") 'split the cell based on / and store it in splitter
If (UBound(splitter)) > 0 Then 'if a split occurred
ActiveCell.Offset(i, 0).Value = "" 'set the activecell to blank
Debug.Print i
ActiveCell.Offset(i + 1, 0).EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove 'insert a new row and shift everything down

ActiveCell.Offset(i + 1, 0).Value = splitter(0) 'initialize the "Down" cells
ActiveCell.Offset(i + 1, 0).Value = Replace(ActiveCell.Offset(i + 1, 0).Value, "!@#", " / ")
For j = 1 To UBound(splitter)
ActiveCell.Offset(i + j + 1).EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove 'create another row if it needs to
ActiveCell.Offset(i + (j + 1), 0).Value = ActiveCell.Offset(i + j).Value & "/" & splitter(j) 'fill out the new row
ActiveCell.Offset(i + (j + 1), 0).Value = Replace(ActiveCell.Offset(i + (j + 1), 0).Value, "!@#", " / ")
Next
i = i + UBound(splitter) + 1 'need to step I past the new cells
ReDim splitter(0)
Erase splitter 'erase and eliminate splitter to avoid carry over.

End If
Next

End Sub




Oh awesome, very clever so we mass replace all mentions of it then run the document then write them back in. I like it, well this seems to do the job! Thankyou so much for the help dude probably saved me a few days of running in circles. :clap: