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

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

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

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

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

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

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

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

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

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

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

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