Solved: Split ONE word into TWO cells

[Atomski]

Hello everyone,

first time poster, long time lurker :hi:

I need your help witha little problem I ran into.

I have 7500 cels in one column that are in this format: SantaClaus

I need them to be in this format: A1=Santa A2=Claus (split into two cels/columns)

All words are different and have variable length...



Thank you in advance! :bow:
Vlad

[U_Shrestha]

Considering SantaClaus is in C1, in A1 type =LEFT(C1,5)
In a2 type =RIGHT(C1,5)

Limitation: This will bring only 5 characers each in a1 and a2. Does all the cells have 10 characters each?

[Bob Phillips]

What is the break rule?

[Atomski]

Actually no, all the cells have different length words e.g:

SantaClaus
SuperMan
SunnyState

I have even exceptions like these:

LittleBrownFox or
ThomasCruiseMapotherIV or even
GeorgeWBush

I've tried every trick I knew in Excel, but no dice.

Maybe it's time for some VBA code? :think:

[Atomski]

What is the break rule?

Break rule would be UPPER CASE letter

[Bob Phillips]

=LEFT(A1,MIN(FIND(CHAR(ROW(INDIRECT("1:26"))+64),RIGHT(A1,LEN(A1)-1)&"ABCDEFGHIJKLMNOPQRSTUVWXYZ")))

and

=MID(A1,MIN(FIND(CHAR(ROW(INDIRECT("1:26"))+64),RIGHT(A1,LEN(A1)-1)&"ABCDEFGHIJKLMNOPQRSTUVWXYZ"))+1,99)

both are array formulae, so commit with Ctrl-Shift-Enter

[mdmackillop]

Option Explicit
Sub SplitWords()
Dim rng As Range, cel As Range, c As Range
Dim Str As String, Ln As Long, i As Long, j As Long
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cel In rng
Ln = Len(cel)
For i = 1 To Ln
If Asc(Mid(cel, i, 1)) < 91 Then
j = j + 1
Str = Mid(cel, i, 1)
cel.Offset(, j) = Str
Else
Str = Str & Mid(cel, i, 1)
cel.Offset(, j) = Str
End If
Next
Str = ""
j = 0
Next
End Sub

[Atomski]

=LEFT(A1,MIN(FIND(CHAR(ROW(INDIRECT("1:26"))+64),RIGHT(A1,LEN(A1)-1)&"ABCDEFGHIJKLMNOPQRSTUVWXYZ")))

and

=MID(A1,MIN(FIND(CHAR(ROW(INDIRECT("1:26"))+64),RIGHT(A1,LEN(A1)-1)&"ABCDEFGHIJKLMNOPQRSTUVWXYZ"))+1,99)

both are array formulae, so commit with Ctrl-Shift-Enter

Yes, this works! Not for the long example I gave, but nevertheless, after running it several times, I've managed to get even those straightened out.

THANK YOU SO MUCH! :bow:

Vlad

[Atomski]

Option Explicit
Sub SplitWords()
Dim rng As Range, cel As Range, c As Range
Dim Str As String, Ln As Long, i As Long, j As Long
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cel In rng
Ln = Len(cel)
For i = 1 To Ln
If Asc(Mid(cel, i, 1)) < 91 Then
j = j + 1
Str = Mid(cel, i, 1)
cel.Offset(, j) = Str
Else
Str = Str & Mid(cel, i, 1)
cel.Offset(, j) = Str
End If
Next
Str = ""
j = 0
Next
End Sub



This one is even BETTER, it slits each word from the sting into separate cells.

GREAT JOB!

THANK YOU TOO!!!

Vlad

[mdmackillop]

A minor adjustment to replace the existing text

Option Explicit
Sub SplitWords2()
Dim rng As Range, cel As Range, c As Range
Dim Str As String, Ln As Long, i As Long, j As Long
Dim txt As String
Application.ScreenUpdating = False
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
j = -1
For Each cel In rng
txt = cel.Text
For i = 1 To Len(txt)
If Asc(Mid(txt, i, 1)) < 91 Then
j = j + 1
Str = Mid(txt, i, 1)
cel.Offset(, j) = Str
Else
Str = Str & Mid(txt, i, 1)
cel.Offset(, j) = Str
End If
Next
txt = ""
j = -1
Next
Application.ScreenUpdating = True
End Sub

[mdmackillop]

Hi Atomsski,
If this is Solved, you can mark it so using the Thread Tools dropdown
Regards
MD

[Atomski]

Yes, you guys really helped me on this one! This really saved several hours of copy/pasting.

THANK YOU!!!