Tough One! Trying to pull data out of columns seperated by com
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" wrote:
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" wrote:
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
|