help to a very special split

[Guest]

Hi

I have this in a cell "Text 4numbers Text "
I want to take the first text into a cell
then i want to take the 4 numbers into another cell
and then i want to take the last text into another cell

MAybe i can split by the numbers?
like take alle text before the numbers
then take the numbers and then take alle the text
after the numbers???

Hope someone can help.

Besr regards
Alvin

 

[Guest]

Hi Alvin,

If you want to do this with code:
Look at the Split() function in online VBA help for examples, using the
space character as the delimeter.

If you want to do this with inplace formulas:
Assuming text is in A1:
TargetCell1 formula is =LEFT(A1,4).
TargetCell2 formula is =MID((A1,FIND(" ",A1)+1,4)
TargetCell3 formula is =RIGHT(A1,4)


Regards,
Garry

 

[Guest]

Hi Alvin,

Is the text before the numbers the same or the same length?
Is there a space between the text and the numbers?

If there is a space then you can use the Instr function to find the first
string and put that into a variable say a, a = Left(ActiveCell,
InStr(ActiveCell, Chr(32))).

Then find the length of a, b=len(a)+1 (includes then the space.)

Find the number portion c=mid(activecell,b,4), where 4 is the length of the
numbers.

then find the last text

d=right(activecell,len(activecell)-b-4)

Hope this helps

Regards

DavidC

 

[Gary Keramidas]

i have a convoluted way that may work for you
takes the string in a1 and breaks into a3:c3

Sub test2()
Dim i As Long, j As Long, n As Long, z As Long
For i = 1 To Len(Range("a1").Value)
If Asc(Mid(Range("a1").Value, i)) >= 48 And
Asc(Mid(Range("a1").Value, i)) <= 57 Then
Range("a3").Value = Left(Range("a1").Value, i - 1)
j = i
Exit For
End If
Next

For z = 1 To Len(Range("a1").Value)
If Asc(Right(Range("a1").Value, z)) >= 48 And
Asc(Right(Range("a1").Value, z)) <= 57 Then
Range("C3").Value = Right(Range("a1"), z - 1)
n = z
Exit For
End If
Next
Range("b3").Value = Mid(Range("A1"), j, Len(Range("a1")) - (j - 1 + n - 1))
End Sub

 

[RB Smissaert]

This is a function that splits a string on numbers versus non-numbers:


Function SplitOnNumbers(strToSplit As String, _
Optional lReturnElement = -1) As Variant

Dim i As Long
Dim n As Long
Dim btArray() As Byte
Dim coll As Collection
Dim arr
Dim bNumber As Boolean
Dim bHadDecimal As Boolean

If Len(strToSplit) < 2 Then
SplitOnNumbers = strToSplit
Exit Function
End If

'make a byte array
'-----------------
btArray = strToSplit

Set coll = New Collection

For i = 0 To UBound(btArray) Step 2
If bNumber = False Then
If btArray(i) > 47 And btArray(i) < 58 Then
bNumber = True
bHadDecimal = False
If i > 0 Then
coll.Add Mid$(strToSplit, n / 2 + 1, (i - n) / 2)
End If
n = i
End If
Else 'If bNumber = False
If bHadDecimal Then
If btArray(i) < 48 Or btArray(i) > 57 Then
bNumber = False
bHadDecimal = False
If i > 0 Then
coll.Add Mid$(strToSplit, n / 2 + 1, (i - n) / 2)
End If
n = i
End If
Else 'If bHadDecimal
If btArray(i) < 44 Or btArray(i) > 57 Then
bNumber = False
bHadDecimal = False
If i > 0 Then
coll.Add Mid$(strToSplit, n / 2 + 1, (i - n) / 2)
End If
n = i
Else 'If btArray(i) < 44 Or btArray(i) > 57
If btArray(i) = 44 Or btArray(i) = 46 Then
bHadDecimal = True
Else 'If btArray(i) = 44 Or btArray(i) = 46
If btArray(i) = 45 Or btArray(i) = 47 Then
bNumber = False
bHadDecimal = False
If i > 0 Then
coll.Add Mid$(strToSplit, n / 2 + 1, (i - n) / 2)
End If
n = i
End If
End If 'If btArray(i) = 44 Or btArray(i) = 46
End If 'If btArray(i) < 44 Or btArray(i) > 57
End If 'If bHadDecimal
End If 'If bNumber = False

'adding the final group
'----------------------
If i = UBound(btArray) - 1 Then
If i > 0 Then
coll.Add Mid$(strToSplit, n / 2 + 1)
End If
End If
Next

'transfer collection to array
ReDim arr(1 To coll.Count)

For i = 1 To coll.Count
arr(i) = coll(i)
Next

If lReturnElement = -1 Then
SplitOnNumbers = arr
Else
SplitOnNumbers = arr(lReturnElement)
End If

End Function



Using this your problem is easy to solve, for example:

In cell A1 you have AAA1234BBBB

Put in Cell B1 the formula: =SplitOnNumbers($A$1,1)
Put in Cell B2 the formula: =SplitOnNumbers($A$1,2)
Put in Cell B3 the formula: =SplitOnNumbers($A$1,3)

You can use the same function in VBA as well, without using worksheet
functions.

Doing this with a byte array is I think (haven't tested this particular
function) faster than doing this on the string itself.


RBS

 

[Guest]

Hi Gary,

Here's a not-so-convoluted way: <FWIW>

Sub ParseMyString()
Dim s As Variant, iCol As Integer

iCol = 1
For Each s In Split(Range("A1").Value, " ")
Range("A1").Offset(, iCol).Value = s
iCol = iCol + 1
Next

End Sub

 

[Guest]

Here's something that suits any length of text either side of the four
numbers between.

In place formula; assumes text is in A1 and three separate string follow in
B1, C1, and D1 respectively.

B1 formula:
=IF($A1<>"",LEFT($A1,FIND(" ",$A1)-1),"")

C1 formula: 'assumes there are always 4 digits
=IF($A1<>"",MID($A1,(LEN($B1)+2),4),"")

D1 formula:

=IF($A1<>"",MID($A1,(LEN($B1)+LEN($C1))+3,LEN($A1)-(LEN($B1)+LEN($C1)+2)),"")

I posted the Split() code to Gary's reply.

HTH
Regards,
Garry

 

[Norman Jones]

Hi Gary S,

Here's a not-so-convoluted way: <FWIW>

Assuming the ability to use the space delimiter, perhaps your code could be
further shortened, e.g.:

'=============>>
Sub ParseMyString2()
Dim arr As Variant

arr = Split(Range("A1").Value, " ")
Range("A1")(1, 2).Resize(1, UBound(arr) + 1).Value = arr
End Sub
'<<=============

 

[Norman Jones]

Assuming the ability to use the space delimiter

And assuming xl2k or later ...

 

[Gary Keramidas]

i'm not sure if there were spaces or the op was just showing the text and
number split, so I assumed there were no spaces and it was all 1 string.

 

[Guest]

Hi Norman,

Thanks for sharing that, ..I like it!

<BTW> I wasn't so concerned about the length of the code as I was the
simplicity of it to the OP.

Regards,
Garry

 

[Guest]

You raise a good point. It is rather ambiguous about the spaces. I guess
we'll have to see how the OP replies.

 

[Guest]

Here's something that will handle things whether there's spaces or not, and
any amount of number characters between the text.

Sub ParseMixedString()
' Parses a string containing numbers between alpha characters
' Requires FilterNumber() and FilterString() functions

Dim sText As String, sNumText As String, sText1 As String, sText2 As String
Dim iPos As Integer

sText = ActiveCell.Value ' Range("A1").Value
sNumText = FilterNumber(sText, False)
iPos = InStr(1, sText, sNumText, vbTextCompare) - 1
sText1 = Left$(sText, iPos)
sText2 = Mid$(sText, Len(sText1) + Len(sNumText) + 1)
With ActiveCell 'Range("A1")
.Offset(, 1).Value = Trim(sText1)
.Offset(, 2).Value = sNumText
.Offset(, 3).Value = Trim(sText2)
End With
End Sub


Function FilterNumber(Text As String, TrimZeros As Boolean) As String
' Filters out formatting characters in a number and trims any trailing
decimal zeros
' Requires the FilterString function
' Arguments: Text The string being filtered
' TrimZeros True to remove trailing decimal zeros
' Returns: String containing valid numeric characters.

Const sSource As String = "FilterNumber()"

Dim decSep As String, i As Long, sResult As String

' Retreive the decimal separator symbol
decSep = Format$(0.1, ".")
' Filter out formatting characters
sResult = FilterString(Text, decSep & "-0123456789")
' If there's a decimal part, trim any trailing decimal zeros
If TrimZeros And InStr(Text, decSep) > 0 Then
For i = Len(sResult) To 1 Step -1
Select Case Mid$(sResult, i, 1)
Case decSep
sResult = Left$(sResult, i - 1)
Exit For
Case "0"
sResult = Left$(sResult, i - 1)
Case Else
Exit For
End Select
Next
End If
FilterNumber = sResult

End Function


Function FilterString(Text As String, ValidChars As String) As String
' Filters out all unwanted characters in a string.
' Arguments: Text The string being filtered
' validChars The characters to keep
' Returns: String containing only the valid characters.

Const sSource As String = "FilterString()"

Dim i As Long, sResult As String

For i = 1 To Len(Text)
If InStr(ValidChars, Mid$(Text, i, 1)) Then sResult = sResult &
Mid$(Text, i, 1)
Next
FilterString = sResult

End Function

Enjoy,
Garry

 

[Tom Ogilvy]

Trailing zeros should be stripped by excel anyway. Without much testing,
this would seem to be at least as robust for the postulated string and
probably easier to follow.

Sub ABD()
Dim bNum As Boolean, bNumLast As Boolean
Dim sText As String, sText1 As String
Dim sText2 As String, sNumText As String
Dim sChr As String, i As Long, ds as String

ds = Application.International(xlDecimalSeparator)

sText = ActiveCell.Value ' Range("A1").Value
bNum = False
bNumLast = False

sText1 = Left(sText, 1)
For i = 2 To Len(sText)
sChr = Mid(sText, i, 1)
If IsNumeric(sChr) Or sChr = "-" Or _
(bNumLast And sChr = ds) Then
sNumText = sNumText & sChr
bNum = True
bNumLast = True
ElseIf bNum Then
sText2 = sText2 & sChr
bNumLast = False
Else
sText1 = sText1 & sChr
End If
Next

With ActiveCell 'Range("A1")
.Offset(, 1).Value = Trim(sText1)
.Offset(, 2).Value = Trim(sNumText)
.Offset(, 3).Value = Trim(sText2)
End With
End Sub


This would probably be a better way to get the decimal separator:

Application.International(xlDecimalSeparator)

I could be wrong, but I think Format will always return a period.

 

[Guest]

Hi Tom
Thanks for the help again!!!!!!!!!!!!!!!!

I juts have a problem because in my case i have this ( i know it was not
what i write in the forste place)

Look at this:
Kirketorvet 10 Tranely 8310 Tranbjerg
or this:
Forteleddet 27 Forteleddet 8240 Risskov

Here i want Forteleddet 27 in one cell
and Forteleddet into another cell
and 8240 into the next cell
and Risskov into the last cell

all text is like this like
Text numbers in one cell
text in next cell
numbers in next cell
and
text in last cell

Hope this can bee done ?
best regards alvin
Or can i split by " " i mean lokk at the text
Kirketorvet 10 Tranely 8310 Tranbjerg
if i can say take all text/numbers before second " "
then i have Kirketorvet 10
then again take all from second " " to 3 " " then i have Tranely
an so on
can this bee done?

 

[Guest]

Hi
Well its nearly working
But i have a problem
in my case i have

Jellebakken 10 Væksthuset 8240 Risskov

here i want all the text before second " " into a cell
so Jellebakken 10 into the forst cell and Væksthuset into the next
and 8240 into rhe next and Risskov into the next

So you code works , I just want o change it so i get all text to the second
" " into my first cell

So if i could take the first value and the second value and make it to one
value then i have what i want

Regards
Alvin

 

[RB Smissaert]

Maybe try this function:


Function SplitOnNumbers(strToSplit As String, _
Optional lReturnElement = -1, _
Optional bTrim As Boolean = True, _
Optional btSeparator1 As Byte = 46, _
Optional btSeparator2 As Byte = 44) As Variant

'Will split a string on the change from number to non-number and vice
versa
'Optional to return only one element from the array or return a single
variable
'Optional to trim the return string(s), default is True
'Optional to set the decimal characters, default to do both comma and dot
'---------------------------------------------------------------------------
Dim i As Long
Dim n As Long
Dim btArray() As Byte
Dim coll As Collection
Dim arr
Dim bNumber As Boolean
Dim bHadDecimal As Boolean

If Len(strToSplit) < 2 Then
SplitOnNumbers = strToSplit
Exit Function
End If

'make a byte array
'-----------------
btArray = strToSplit

Set coll = New Collection

For i = 0 To UBound(btArray) Step 2
If bNumber = False Then
If btArray(i) > 47 And btArray(i) < 58 Then
bNumber = True
bHadDecimal = False
If i > 0 Then
'adding non-number
'-----------------
coll.Add Mid$(strToSplit, n / 2 + 1, (i - n) / 2)
End If
n = i
End If
Else 'If bNumber = False
If bHadDecimal Then
If btArray(i) < 48 Or btArray(i) > 57 Then
bNumber = False
bHadDecimal = False
If i > 0 Then
'adding number with separator
'----------------------------
coll.Add Mid$(strToSplit, n / 2 + 1, (i - n) / 2)
End If
n = i
End If
Else 'If bHadDecimal
If btArray(i) < 44 Or btArray(i) > 57 Then
bNumber = False
bHadDecimal = False
If i > 0 Then
'adding number with no separator
'-------------------------------
coll.Add Mid$(strToSplit, n / 2 + 1, (i - n) / 2)
End If
n = i
Else 'If btArray(i) < 44 Or btArray(i) > 57
If (btArray(i) = btSeparator1 Or _
btArray(i) = btSeparator2) Then
If i = UBound(btArray) - 1 Then
If i > 0 Then
'adding number with no separator
'-------------------------------
coll.Add Mid$(strToSplit, n / 2 + 1, (i - n) / 2)
End If
n = i
Else
If btArray(i + 2) > 46 And btArray(i + 2) < 58 Then
'separator, just carry on as number
'----------------------------------
bHadDecimal = True
End If
End If
Else 'If btArray(i) = 44 Or btArray(i) = 46
'If btArray(i) = 45 Or btArray(i) = 47 Then
If btArray(i) < 48 Or btArray(i) > 57 Then
bNumber = False
bHadDecimal = False
If i > 0 Then
'adding number with no separator
'-------------------------------
coll.Add Mid$(strToSplit, n / 2 + 1, (i - n) / 2)
End If
n = i
End If
End If 'If btArray(i) = 44 Or btArray(i) = 46
End If 'If btArray(i) < 44 Or btArray(i) > 57
End If 'If bHadDecimal
End If 'If bNumber = False

'adding the final group
'----------------------
If i = UBound(btArray) - 1 Then
If i > 0 Then
coll.Add Mid$(strToSplit, n / 2 + 1)
End If
End If
Next

'transfer collection to array
ReDim arr(1 To coll.Count)

If bTrim Then
For i = 1 To coll.Count
arr(i) = Trim(coll(i))
Next
Else
For i = 1 To coll.Count
arr(i) = coll(i)
Next
End If

If lReturnElement = -1 Then
SplitOnNumbers = arr
Else
SplitOnNumbers = arr(lReturnElement)
End If

End Function


Added a few things as the last character in a string shouldn't be a decimal
and you may want to specify the separator characters.
Will trim all the elements by default.

It may look complex, but you only deal with the simple usage of this
function.
If you use this as a worksheet function and you have:
Jellebakken 10 Væksthuset 8240 Risskov
in cell A1 you could do:
in B1: =SplitOnNumbers($A$1,1)
in B2: =SplitOnNumbers($A$1,2)
etc.


if you use it in VBA you would do something like this:

Sub SplitCell()

Dim arr
Dim i As Long

arr = SplitOnNumbers(Cells(1))

For i = 1 To UBound(arr)
Cells(i, 2) = arr(i)
Next

End Sub



RBS

 

[Guest]

Hi
and thnaks for the help
Its allmost working
look at this
Marselis Boulevard 48 Marselis Boulevard 8000 Ã…rhus C

In my first celle i get Marselis Boulevard
in the next i get 48
but i want to have Marselis Boulevard 48 in my first cell

Its the only thing there isn't Ok all the next text and numbers are OK
Hope you can help ?

regards
alvin

 

[RB Smissaert]

Well, only you will know what the rules/logic of the data is.
If you know that the data always starts with:
text number, which you want to put together in one cell
then it is easy, you could do for example:
in cell B1: = SplitOnNumbers(A1,1) & " " & SplitOnNumbers(A1,2)
in cell B2: = SplitOnNumbers(A1,3)
etc.

But I don't know if it always starts with text number, to be concatenated.

What you could do is split the data and if element 1 is non-numeric and
element 2 is numeric then take it
tha these 2 should be put together, otherwise not.
I am not sure if there could be a problem with postcodes, consisting of text
and numbers together.
It is just not possible to solve this by people that don't know the data.

RBS

 

[Guest]

Its allright i got it to work
I just make a cell to the numbers
so it working with:
Sub SplitCell()
Dim arr
Dim i As Long
arr = SplitOnNumbers(ActiveCell.Value)
For i = 1 To UBound(arr)
ActiveCell.Offset(, i) = arr(i)
End Sub

But can you help me about a loop
so my active.cell move down and do this
to active.cell is empty

I have try but ??????????

reagards
Alvin