Vba to split up words in a cell by the capital letters

[tonywatsonhelp]

Hi everyone,
We down load data and it comes out badly formatted sometimes so we get thing like "NatureFoods Ltd." instead of Nature Foods Ltd

I'd like a macro that can help me separate words that have been stuck together.

what id like is for a macro to go down each cell in range C10:C50

And look at the words in these cells one at a time,
If there is a capital letter amongst lowercase letters add a space, but only if the capital has a lower case in front and behind it

please help if you can

thanks

Tony

 

[lrobbo314]

One way,

SplitByCase.xlsm
	C	D
9	Original	Split
10	NatureFoods Ltd.	Nature Foods Ltd.
11	NetWare	Net Ware
12	LibreOffice	Libre Office
13	CyberMax	Cyber Max
14	SuperDisk	Super Disk
15	BlackBerry	Black Berry
16	SharePoint	Share Point
17	ExpressCard	Express Card
18	VisiCalc	Visi Calc
19	ImageShack	Image Shack
20	MacBook	Mac Book
21	FiveThirtyEight	Five Thirty Eight
Sheet1

Sub LUS()
Dim r As Range:         Set r = Range("C10:C" & Range("C" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2
Dim b() As Byte

For i = 1 To UBound(AR)
    AR(i, 1) = cSplit(AR(i, 1))
Next i

r.Offset(, 1).Value = AR
End Sub

Function cSplit(s As Variant)
Dim b() As Byte: b = s

For i = UBound(b) - 3 To 2 Step -2
    If b(i - 2) > 96 And b(i - 2) < 123 And b(i) > 64 And b(i) < 91 Then
        s = Application.WorksheetFunction.Replace(s, (i / 2) + 1, 0, " ")
    End If
Next i

cSplit = s
End Function

 

[lrobbo314]

Or, using Power Query.

SplitByCase.xlsm
	A	B
1	Original	Split
2	NatureFoods Ltd.	Nature Foods Ltd.
3	NetWare	Net Ware
4	LibreOffice	Libre Office
5	CyberMax	Cyber Max
6	SuperDisk	Super Disk
7	BlackBerry	Black Berry
8	SharePoint	Share Point
9	ExpressCard	Express Card
10	VisiCalc	Visi Calc
11	ImageShack	Image Shack
12	MacBook	Mac Book
13	FiveThirtyEight	Five Thirty Eight
Sheet2

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Split = Table.SplitColumn(Source, "Original", Splitter.SplitTextByCharacterTransition({"a".."z"}, {"A".."Z"}), {"Original.1", "Original.2", "Original.3"}),
    Merge = Table.CombineColumns(Split,{"Original.1", "Original.2", "Original.3"},Combiner.CombineTextByDelimiter(" ", QuoteStyle.None),"Split")
in
    Merge

 

[JamesCanale]

Or dynamic arrays (it's messy)

MrExcelPlayground4.xlsx
	A	B
30	BigBadWolf	Big Bad Wolf
31	SillyGoose	Silly Goose
32	Silly Goose	Silly Goose
33	SillyGOOSE	SillyGOOSE
34	BigBadWolf	Big Bad Wolf
Sheet33

Cell Formulas
Range	Formula
B30:B34	B30	=TEXTJOIN(,TRUE,IF((IF((IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))>64),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))<98),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))>96),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))<123),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))>96)*(CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))<123),0))=0,SEQUENCE(ROWS((IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))>64),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))<98),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))>96),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))<123),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))>96)*(CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))<123),0)))),""))<>"",MID(A30,(IF((IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))>64),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))<98),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))>96),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))<123),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))>96)*(CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))<123),0))=0,SEQUENCE(ROWS((IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))>64),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))<98),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))>96),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))<123),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))>96)*(CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))<123),0)))),"")),1),MID(A30,(IF((IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))>64),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))<98),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))>96),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))<123),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))>96)*(CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))<123),0))=1,SEQUENCE(ROWS((IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))>64),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,2,1),1))<98),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))>96),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,1,1),1))<123),0)*IFERROR((CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))>96)*(CODE(MID(A30,SEQUENCE(LEN(A30),1,3,1),1))<123),0)))),"")),1)&" "))

 

[tonywatsonhelp]

OMG, lots of options,
thank you all,
i'm going to try lrobbo314 idea first as that looks most suited to my needs
Thank you all very much
Thanks
Tony

 

[lrobbo314]

Right on.

Here's another VBA option that uses a different approach.

Sub LUX()
Dim r As Range:         Set r = Range("C10:C" & Range("C" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2

With CreateObject("VBScript.RegExp")
    .Pattern = "([a-z])([A-Z])"
    For i = 1 To UBound(AR)
        AR(i, 1) = .Replace(AR(i, 1), "$1 $2")
    Next i
    r.Offset(, 1).Value = AR
End With
End Sub

 

[JEC]

One more:

Function jec(cell) As String
 With CreateObject("VBscript.Regexp")
  .Global = True
  .Pattern = "(?=[A-ZÄÖÜ])"
  jec = Trim(.Replace(Replace(cell, " ", ""), " "))
 End With
End Function