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" wrote:

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" wrote:

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