Have you looked at Text to columns on the data tab? This might achieve exactly what you are after
I have 1 column with over 50,000 rows containing data strings (they are actually basketball game scores) that are currently formatted like this:
Teama ##-## Teamb
The '#' represent numeric digits, although many were interpreted as letters or other symbols by OCR software. These start in cell E2. I am wanting to use formulas to separate that data from E2 out into the four cells to the right looking something like this:
F2-- Teama
G2-- ## (the first score)
H2-- ## (second score)
I2-- Teamb
There is some inconsistency in that sometimes the ## is actually a single digit or even three, and there are also names that have spaces or hyphens in the middle (West Haven or Spencer-Green). Basically I am looking for any help to create formulas that will do the bulk of the work and then I assume that I will have to go back and do some manipulation of those that do not fit exactly.
Any help is appreciated.
Have you looked at Text to columns on the data tab? This might achieve exactly what you are after
I visit this site mainly to remember how little I know
Those inconsistencies are what will make a formula solution problematice, but you can do what you want using this macro...
HOW TO INSTALL MACROsCode:
Sub SplitTeamsAndScores() Dim R As Long, X As Long, Txt As String, Data As Variant, Answer As Variant Data = Range("A1", Cells(Rows.Count, "A").End(xlUp)) ReDim Answer(1 To UBound(Data), 1 To 1) For R = 1 To UBound(Data) Txt = Data(R, 1) For X = 1 To Len(Txt) If Mid(Txt, X, 3) Like "#-#" Then Txt = Left(Txt, X) & Chr(1) & Mid(Txt, X + 2) Txt = Application.Replace(Txt, InStrRev(Txt, " ", X), 1, Chr(1)) Txt = Application.Replace(Txt, InStr(X, Txt, " "), 1, Chr(1)) Answer(R, 1) = Txt End If Next Next Range("B1").Resize(UBound(Answer)) = Answer Columns("B").TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1) End Sub
------------------------------------
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (SplitTeamsAndScores) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "Yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.
Last edited by Rick Rothstein; Feb 18th, 2018 at 03:44 PM.
Rick's "mini" blog... http://www.excelfox.com/forum/f22/
.
Want to post a small screen shot? See Part B here.
JUst tried that as described and I get this message:
'Run-time error '13': Type mismatch
Rick's "mini" blog... http://www.excelfox.com/forum/f22/
.
Want to post a small screen shot? See Part B here.
Messy, but works
Excel 2010
A B C D E 1 Original Col1 Col2 Col3 Col4 2 EastVille-Landrunners 71 -23 Krypton-Space EastVille-Landrunners 71 23 Krypton-Space 3 Neutral-Brainers 8 -129 Prof-Baskets Neutral-Brainers 8 129 Prof-Baskets 4 Size 71 -78 Penetrate Size 71 78 Penetrate 5 Prof-Baskets 124 -119 Smallville Prof-Baskets 124 119 Smallville 6 Miner 128 -12 Rhetoric-Question Miner 128 12 Rhetoric-Question 7 Addicted 37 -27 Size Addicted 37 27 Size 8 Size 127 -123 Complain Size 127 123 Complain Sheet2
Worksheet Formulas
Cell Formula B2 =TRIM(LEFT(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))-1)) C2 =TRIM(MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),FIND("-",MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),10))-1)) D2 =TRIM(MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))+FIND("-",MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),10)),(MIN(FIND({0,1,2,3,4,5,6,7,8,9},MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))+FIND("-",MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),10))-1,LEN(A2)-MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))+FIND("-",MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),10))-1)&"0123456789")))+1)) E2 =TRIM(RIGHT(MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))+FIND("-",MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),10))-1,LEN(A2)-MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))+FIND("-",MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),10))-1),LEN(MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))+FIND("-",MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),10))-1,LEN(A2)-MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))+FIND("-",MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),10))-1))-FIND(" ",MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))+FIND("-",MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),10))-1,LEN(A2)-MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))+FIND("-",MID(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),10))-1))))
Rick I had a go with your code
You get the above error if you only have one item to parse.
I have tried several times with plenty of lines and the code stops here
Columns("B").TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1)
Run time error 1004 No data was selected to parse
I visit this site mainly to remember how little I know
I think this modified code fixes that problem and another potential problem that I think could also affect the results.
Code:
Sub SplitTeamsAndScores() Dim R As Long, X As Long, Txt As String, Data As Variant, Answer As Variant Data = Range("A1", Cells(Rows.Count, "A").End(xlUp).Offset(1)) ReDim Answer(1 To UBound(Data), 1 To 1) For R = 1 To UBound(Data) Txt = Replace(Replace(Data(R, 1), " -", "-"), "- ", "-") For X = 1 To Len(Txt) If Mid(Txt, X, 3) Like "#-#" Then Txt = Left(Txt, X) & Chr(1) & Mid(Txt, X + 2) Txt = Application.Replace(Txt, InStrRev(Txt, " ", X), 1, Chr(1)) Txt = Application.Replace(Txt, InStr(X, Txt, " "), 1, Chr(1)) Answer(R, 1) = Txt End If Next Next Range("B1").Resize(UBound(Answer)) = Answer Columns("B").TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1) End Sub
Last edited by Rick Rothstein; Feb 18th, 2018 at 06:11 PM.
Rick's "mini" blog... http://www.excelfox.com/forum/f22/
.
Want to post a small screen shot? See Part B here.
yup, Perfect Rick
I visit this site mainly to remember how little I know
Like this thread? Share it with others