Tough One! Trying to pull data out of columns seperated by commas.

[David B]

I have a HUGE spreadsheet of cross reference information.

One column SOMETIMES contains several "model numbers" - not just one.

I'd like to be able to RIP OUT the data between commas in that column and
make a new row for just that one piece of data and then put all of the same
data from the columns back around the data... Hard to describe. Here is a
simplified example of what we are trying to do.

red....tree, bush, shrub, grass....money....car
blue..bike.................................cat.........truck
tan...apple, pear.......................dog........plane

Id like it to look like this:

red...tree.................................money.....car
red...bush................................money.....car
red...shrub...............................money.....car
red...grass...............................money.....car
blue..bike.................................cat..........truck
tan...apple................................dog.........plane
tan...pear.................................dog.........plane

That is what we are trying to do!

Thanks for your help

 

[Joel]

I'm good a tough problems. Highlight the cell you wantt to interpret on
Sheet3 the results are on sheet 1





Sub ExtractStrings()

Const Inputworksheet = "Sheet3"
Const Outputworksheet = "Sheet1"
Const InputStartColumn = 3
Const OutputStartColumn = 1

Set Myrange = ActiveCell
Startrow = Myrange.Row

EndRow = ActiveCell.End(xlDown).Row

DestrowCount = 1

For RowCount = Startrow To EndRow

inputstring = Worksheets(Inputworksheet).Cells(RowCount,
InputStartColumn).Value

phases = 0
If InStr(inputstring, ",") = 0 Then

Worksheets(Outputworksheet).Cells(DestrowCount, OutputStartColumn)
= _
Worksheets(Inputworksheet).Range(Cells(RowCount,
InputStartColumn), Cells(RowCount, InputStartColumn))

DestrowCount = DestrowCount + 1
Else

'find last commar
Lastcommar = 1
Do While InStr(Mid(inputstring, Lastcommar), ",") <> 0
Lastcommar = InStr(Mid(inputstring, Lastcommar), ",") + Lastcommar
phases = phases + 1

Loop

phases = phases + 1

getdot = InStr(Mid(inputstring, Lastcommar), ".") + Lastcommar - 1
Firststring = Left(inputstring, (getdot - 1))
SecondString = Mid(inputstring, getdot)

Lastdot = 1
Do While InStr(Mid(Firststring, Lastdot), ".") <> 0
Lastdot = InStr(Mid(Firststring, Lastdot), ".") + Lastdot
Loop
FirstPhase = Left(Firststring, Lastdot - 1)
Firststring = Mid(Firststring, Lastdot)


For Myphases = 1 To phases

If InStr(Firststring, ",") <> 0 Then
SecondPhase = Left(Firststring, InStr(Firststring, ",") - 1)
Firststring = Mid(Firststring, InStr(Firststring, ",") + 1)
Else

SecondPhase = Firststring
Firststring = ""

End If


OutputString = FirstPhase + SecondPhase + SecondString

Worksheets(Outputworksheet).Cells(DestrowCount,
OutputStartColumn) = OutputString


DestrowCount = DestrowCount + 1

'remove blanks
Do While StrComp(Left(Firststring, 1), " ") = 0
Firststring = Mid(Firststring, 2)
Loop

Next Myphases
End If

Next RowCount

End Sub

 

[David B]

Wow!

Thanks for putting so much effort into this.

I'm pretty new to macros. So I put made an entirely new file and pasted the
entire original spreadsheet data into Sheet3 and then cut and pasted the
macro. When I ran it, I got "compile error - syntax error" and it stopped at
(and highlighted in red)

inputstring = Worksheets(Inputworksheet).Cells(RowCount,
InputStartColumn).Value



It also highlighted the two following sections in red:

Worksheets(Outputworksheet).Cells(DestrowCount, OutputStartColumn)
= _
Worksheets(Inputworksheet).Range(Cells(RowCount,
InputStartColumn), Cells(RowCount, InputStartColumn))

This is the last section in red...

Worksheets(Outputworksheet).Cells(DestrowCount,
OutputStartColumn) = OutputString


maybe I'm not entering your macro correctly or I have to name something
differently? When you say highlight the cells you want to interpret on
Sheet3, I just dumped the entire spreadsheet on Sheet3, selected everything
with the button left of "A" and above "1" on Sheet3 and ran the macro...

I appreciate your help so much!


David

***********

 

[Joel]

The lines wraped. I shorten lines to try to stop this problem. didn't know
what you expertise was in VBA


Sub ExtractStrings()

Const Inputworksheet = "Sheet3"
Const Outputworksheet = "Sheet1"
Const InputStartColumn = 3
Const OutputStartColumn = 1

Set Myrange = ActiveCell
Startrow = Myrange.Row

EndRow = ActiveCell.End(xlDown).Row

DestrowCount = 1

For RowCount = Startrow To EndRow

inputstring = _
Worksheets(Inputworksheet). _
Cells(RowCount, InputStartColumn).Value

phases = 0
If InStr(inputstring, ",") = 0 Then

Worksheets(Outputworksheet). _
Cells(DestrowCount, OutputStartColumn) = _
Worksheets(Inputworksheet). _
Range(Cells(RowCount, InputStartColumn), _
Cells(RowCount, InputStartColumn))

DestrowCount = DestrowCount + 1
Else

'find last commar
Lastcommar = 1
Do While InStr(Mid(inputstring, Lastcommar), ",") <> 0
Lastcommar = _
InStr(Mid(inputstring, Lastcommar), ",") + Lastcommar
phases = phases + 1

Loop

phases = phases + 1

getdot = _
InStr(Mid(inputstring, Lastcommar), ".") + Lastcommar - 1
Firststring = Left(inputstring, (getdot - 1))
SecondString = Mid(inputstring, getdot)

Lastdot = 1
Do While InStr(Mid(Firststring, Lastdot), ".") <> 0
Lastdot = InStr(Mid(Firststring, Lastdot), ".") + Lastdot
Loop
FirstPhase = Left(Firststring, Lastdot - 1)
Firststring = Mid(Firststring, Lastdot)


For Myphases = 1 To phases

If InStr(Firststring, ",") <> 0 Then
SecondPhase = _
Left(Firststring, InStr(Firststring, ",") - 1)
Firststring = _
Mid(Firststring, InStr(Firststring, ",") + 1)
Else

SecondPhase = Firststring
Firststring = ""

End If


OutputString = FirstPhase + SecondPhase + SecondString

Worksheets(Outputworksheet). _
Cells(DestrowCount, OutputStartColumn) = OutputString


DestrowCount = DestrowCount + 1

'remove blanks
Do While StrComp(Left(Firststring, 1), " ") = 0
Firststring = Mid(Firststring, 2)
Loop

Next Myphases
End If

Next RowCount

End Sub

 

[David B]

It seperated the strings of data divided by commas beautifully and placed
them in a column on Sheet1 !

But it did not "add back in" the information from the other columns on the
row where that data originally came from. That is the real tricky part. I
know this is a real tough one. I probably can get to what I want eventually
with maybe a series of if/thens or something.

don't sweat it too much. I appreciate your efforts already more than you can
know.

 

[Joel]

My data looked exactly like your result that you posted. Check the column
widths on sheet 1 to make sure you are seeing all the data. Maybe I just
don't understand what I missed in your instructions.

 

[David B]

I'd be happy to e-mail you the file. It is not really any proprietary
information if you are at all interested in trouble shooting it.

 

[Joel]

David: below are the results that I got. There were two situations I wasn't
sure how to code because the instructions were not detailed enough. I had to
make executive descisions on the best way of handling these situations based
on my experience.

I've have written code like this beffore. It is basically parsing of words
following a language witth rules of grammar. I didn't know of fixed or
parsing of the strings (not adding exttra spaces) was the objective.


1) What should be done with the spaces in the comma words. I deleted all
spaces.
2) How many dots to put between the comma portion of the line and the end
words. I simply made a copy of the llast part of the line which is from the
last commar word to the end of the line. Then I pasted this string to the
end of my new lines where the words were seperated into individual lines.

If there is a better way of handling these two situations I will change the
code. I'm glad the code worked.

red....tree....money....car
red....bush....money....car
red....shrub....money....car
red....grass....money....car
blue..bike.................................cat.........truck
tan...apple.......................dog........plane
tan...pear.......................dog........plane

 

[David B]

Joel,

Thanks! You gave me enough additional information there so that I could make
it work. It works perfectly now. Thank you so much. You are very talented!