Split text field in VBA

[PeCoNe]

How can i split the next text field on space in VBA:
AEX*: 342,00 -2,71 -0,79% O: 345,37 H: 345,52 L: 341,67 C: 344,71
18:05:01 AEX-25: 2â–² 23â–¼ 0=

thanks.

 

[Claus Busch]

Hi Peter,

Am Sat, 29 Dec 2012 14:33:51 +0100 schrieb PeCoNe:

How can i split the next text field on space in VBA:
AEX*: 342,00 -2,71 -0,79% O: 345,37 H: 345,52 L: 341,67 C: 344,71
18:05:01 AEX-25: 2? 23? 0=

this string is in A52. You can split it and write back in row 52:

Sub Test()
Dim myArr As Variant
Dim i As Integer

With Sheets("IEX")
myArr = Split(.Range("A52"), " ")
For i = 0 To UBound(myArr)
.Cells(52, i + 1) = myArr(i)
Next
End With
End Sub


Regards
Claus Busch

 

[PeCoNe]

Op 2012-12-29 14:53, Claus Busch schreef:

Hi Peter,

Am Sat, 29 Dec 2012 14:33:51 +0100 schrieb PeCoNe:


this string is in A52. You can split it and write back in row 52:

Sub Test()
Dim myArr As Variant
Dim i As Integer

With Sheets("IEX")
myArr = Split(.Range("A52"), " ")
For i = 0 To UBound(myArr)
.Cells(52, i + 1) = myArr(i)
Next
End With
End Sub


Regards
Claus Busch

Hi Claus,

Again thanks.
Did you miss my last reply on previous problem?
see yesterday 21:40

Bye Peter

 

[Claus Busch]

Hi Peter,

Am Sat, 29 Dec 2012 15:07:23 +0100 schrieb PeCoNe:

Did you miss my last reply on previous problem?
see yesterday 21:40

there's no mail from you in Outlook. Can you send it again?


Regards
Claus Busch

 

[Ron Rosenfeld]

Hi Peter,

Am Sat, 29 Dec 2012 14:33:51 +0100 schrieb PeCoNe:


this string is in A52. You can split it and write back in row 52:

Sub Test()
Dim myArr As Variant
Dim i As Integer

With Sheets("IEX")
myArr = Split(.Range("A52"), " ")
For i = 0 To UBound(myArr)
.Cells(52, i + 1) = myArr(i)
Next
End With
End Sub


Regards
Claus Busch

Being in a certain kind of mood, and given that the original text is in A52, the guts can be reduced to a one liner (in this case, putting the results in row 53)
============================================
[a53].Resize(columnsize:=UBound(Split([A52])) + 1) = Split([A52])
============================================

Or, a longer one-liner using a different technique:

=========================================
[A52].TextToColumns Destination:=[a53], DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, _
consecutivedelimiter:=True, Tab:=False, semicolon:=False, comma:=False, Space:=True, _
other:=False
=========================================

The above do not have worksheet qualifiers, but these can be easily added without adding lines

 

[Claus Busch]

Hi Ron,

Am Sat, 29 Dec 2012 14:05:27 -0500 schrieb Ron Rosenfeld:

============================================
[a53].Resize(columnsize:=UBound(Split([A52])) + 1) = Split([A52])
============================================

thank you for this one liner

=========================================
[A52].TextToColumns Destination:=[a53], DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, _
consecutivedelimiter:=True, Tab:=False, semicolon:=False, comma:=False, Space:=True, _
other:=False
=========================================

TextToColumns is not possible. It is a web query and A1:A74 is filled
with strings, some with space. A52 is a special case.


Regards
Claus Busch

 

[Ron Rosenfeld]

TextToColumns is not possible. It is a web query and A1:A74 is filled
with strings, some with space. A52 is a special case.

From the part of the thread that my newsreader returned, that was not apparent.

BTW, it's Rick Rothstein, who I see here infrequently now, who is a fan of "one-liners". Something today reminded me of him. That's why I posted.

 

[GS]

Ron Rosenfeld has brought this to us :

BTW, it's Rick Rothstein, who I see here infrequently now, who is a fan of
"one-liners". Something today reminded me of him. That's why I posted

I too am a fan of 1 liners, inspired by Rick and so I'm also a fan of
his and his work!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Claus Busch]

Hi Garry,

Am Sat, 29 Dec 2012 16:51:07 -0500 schrieb GS:

I too am a fan of 1 liners, inspired by Rick and so I'm also a fan of
his and his work!

me too, but one liners are for experts. The OP get help but he don't
understand.


Regards
Claus Busch

 

[lhkittle]

Hi Garry,



Am Sat, 29 Dec 2012 16:51:07 -0500 schrieb GS:







me too, but one liners are for experts. The OP get help but he don't

understand.





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Hi Claus,

While lurking in another forum an OP had a similar query as the OP in this
thread. A large bundle of data needing to be seperated as shown here. Youwill notice there are actually five "sentences" numbered 1. 2. 3. 4. & 5.

1. BOYD GAMING CORP (BYD) 3883 Howard Hughes Pkwy., 9th Fl., Las Vegas, Nevada, United States PUBLIC - PARENT 1014789 2. CAESARS ENTERTAINMENT CORP (CZR) 1 Caesars Palace Dr., Las Vegas, Nevada, United States PUBLIC 1022989 3.. INTERNATIONAL GAME TECHNOLOGY INC (IGT) 6355 S. Buffalo Dr., Las Vegas, Nevada, United States PUBLIC - PARENT 1018044 4. Las Vegas Sands Corp. (LVS)3355 Las Vegas Blvd. South, Las Vegas, Nevada, United States PUBLIC - PARENT 1041040 5. MGM RESORTS INTERNATIONAL (MGM) 3600 Las Vegas Blvd. South, Las Vegas, Nevada, United States PUBLIC - PARENT

I tried to modify your orignal code to do the seperations at the 1. 2. 3. etc. by looping and using j to represent the 1. 2. 3.'s in the data instead of a space.
The result was the entire data was copied five times to individual rows below cell B2. Any hints on how to seperate the data 'by the numbers'?

Option Explicit

'by Claus Busch
Sub Test_J()
Dim myArr As Variant
Dim i As Integer
Dim j As Integer
For j = 1 To 5
With Sheets("Sheet1")
myArr = Split(.Range("B2"), "j. ")
For i = 0 To UBound(myArr)
.Cells(j + 2, i + 2) = myArr(i)
Next
End With
Next
End Sub

Thanks,
Howard

 

[Claus Busch]

Hi Howard,

Am Sun, 30 Dec 2012 02:09:05 -0800 (PST) schrieb (e-mail address removed):

While lurking in another forum an OP had a similar query as the OP in this
thread. A large bundle of data needing to be seperated as shown here. You will notice there are actually five "sentences" numbered 1. 2. 3. 4. & 5.

1. BOYD GAMING CORP (BYD) 3883 Howard Hughes Pkwy., 9th Fl., Las Vegas, Nevada, United States PUBLIC - PARENT 1014789 2. CAESARS ENTERTAINMENT CORP (CZR) 1 Caesars Palace Dr., Las Vegas, Nevada, United States PUBLIC 1022989 3. INTERNATIONAL GAME TECHNOLOGY INC (IGT) 6355 S. Buffalo Dr., Las Vegas, Nevada, United States PUBLIC - PARENT 1018044 4. Las Vegas Sands Corp. (LVS) 3355 Las Vegas Blvd. South, Las Vegas, Nevada, United States PUBLIC - PARENT 1041040 5. MGM RESORTS INTERNATIONAL (MGM) 3600 Las Vegas Blvd. South, Las Vegas, Nevada, United States PUBLIC - PARENT

I tried to modify your orignal code to do the seperations at the 1. 2. 3. etc. by looping and using j to represent the 1. 2. 3.'s in the data instead of a space.
The result was the entire data was copied five times to individual rows below cell B2. Any hints on how to seperate the data 'by the numbers'?

my macro is only posible if the delimiter is always the same in the
string. But in your string it is a running number.
Try:

Sub Test_J()
Dim myArr(0 To 4) As Variant
Dim i As Integer
Dim j As Integer
Dim MyStart As Integer
Dim myEnd As Integer
Dim myLen As Integer

With Sheets("Sheet1")
For j = 0 To 4
MyStart = WorksheetFunction.Find(j + 1 & ".", .[B2]) + 3
If j < 4 Then
myEnd = WorksheetFunction.Find(j + 2 & ".", .[B2]) - 2
Else
myEnd = Len(.[B2])
End If
myLen = IIf(j < 4, myEnd - MyStart, Len(.[B2]) - MyStart)
myArr(j) = Mid(.[B2], MyStart, myLen)
Next

For i = 0 To UBound(myArr)
.Cells(j + 3, i + 2) = myArr(i)
Next
End With
End Sub


Regards
Claus Busch

 

[Claus Busch]

Hi Howard,

the last string isn't correct.
Try:
Sub Test_J()
Dim myArr(0 To 4) As Variant
Dim i As Integer
Dim j As Integer
Dim MyStart As Integer
Dim myEnd As Integer
Dim myLen As Integer

With Sheets("Sheet1")
For j = 0 To 4
MyStart = WorksheetFunction.Find(j + 1 & ".", .[B2]) + 3
If j < 4 Then
myEnd = WorksheetFunction.Find(j + 2 & ".", .[B2]) - 1
Else
myEnd = Len(.[B2])
End If
myLen = IIf(j < 4, myEnd - MyStart, Len(.[B2]) - MyStart + 1)
myArr(j) = Mid(.[B2], MyStart, myLen)
Next
j = 0
For i = 0 To UBound(myArr)
.Cells(j + 3, i + 2) = myArr(i)
Next
End With
End Sub

or try:

Sub Test_J2()
Dim myArr(0 To 4) As Variant
Dim i As Integer
Dim j As Integer
Dim MyStart As Integer
Dim myEnd As Integer
Dim myLen As Integer

With Sheets("Sheet1")
For j = 0 To 4
MyStart = InStr(.[B2], j + 1 & ".") + 3
If j < 4 Then
myEnd = InStr(.[B2], j + 2 & ".") - 1
Else
myEnd = Len(.[B2])
End If
myLen = IIf(j < 4, myEnd - MyStart, Len(.[B2]) - MyStart + 1)
myArr(j) = Mid(.[B2], MyStart, myLen)
Next
j = 0
For i = 0 To UBound(myArr)
.Cells(j + 3, i + 2) = myArr(i)
Next
End With
End Sub


Regards
Claus Busch

 

[lhkittle]

Hi Howard,



the last string isn't correct.

Try:

Sub Test_J()

Dim myArr(0 To 4) As Variant

Dim i As Integer

Dim j As Integer

Dim MyStart As Integer

Dim myEnd As Integer

Dim myLen As Integer



With Sheets("Sheet1")

For j = 0 To 4

MyStart = WorksheetFunction.Find(j + 1 & ".", .[B2]) + 3

If j < 4 Then

myEnd = WorksheetFunction.Find(j + 2 & ".", .[B2]) - 1

Else

myEnd = Len(.[B2])

End If

myLen = IIf(j < 4, myEnd - MyStart, Len(.[B2]) - MyStart + 1)

myArr(j) = Mid(.[B2], MyStart, myLen)

Next

j = 0

For i = 0 To UBound(myArr)

.Cells(j + 3, i + 2) = myArr(i)

Next

End With

End Sub



or try:



Sub Test_J2()

Dim myArr(0 To 4) As Variant

Dim i As Integer

Dim j As Integer

Dim MyStart As Integer

Dim myEnd As Integer

Dim myLen As Integer



With Sheets("Sheet1")

For j = 0 To 4

MyStart = InStr(.[B2], j + 1 & ".") + 3

If j < 4 Then

myEnd = InStr(.[B2], j + 2 & ".") - 1

Else

myEnd = Len(.[B2])

End If

myLen = IIf(j < 4, myEnd - MyStart, Len(.[B2]) - MyStart + 1)

myArr(j) = Mid(.[B2], MyStart, myLen)

Next

j = 0

For i = 0 To UBound(myArr)

.Cells(j + 3, i + 2) = myArr(i)

Next

End With

End Sub





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Looks to me like everything you offered works just fine!
I took a few minutes to see if I could alter the code to list the new data into seperate rows instead of columns. No luck. What would I change to list the new data in five rows below cell B2?

Thanks,
Howard

 

[Claus Busch]

Hi Howard,

Am Sun, 30 Dec 2012 03:07:56 -0800 (PST) schrieb (e-mail address removed):

I took a few minutes to see if I could alter the code to list the new data into seperate rows instead of columns. No luck. What would I change to list the new data in five rows below cell B2?

change:
j = 0
For i = 0 To UBound(myArr)
.Cells(j + 3, i + 2) = myArr(i)
Next

to:
For i = 0 To UBound(myArr)
.Cells(i + 3, 2) = myArr(i)
Next


Regards
Claus Busch

 

[lhkittle]

Hi Howard,



Am Sun, 30 Dec 2012 03:07:56 -0800 (PST) schrieb (e-mail address removed):






change:

j = 0

For i = 0 To UBound(myArr)

.Cells(j + 3, i + 2) = myArr(i)

Next



to:

For i = 0 To UBound(myArr)

.Cells(i + 3, 2) = myArr(i)

Next





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

You blow me out of the water! WORKS PERFECT!!!

Thanks Claus, if you ain't the best, you are truly amoung them.

Regards,
Howard

 

[GS]

Claus Busch formulated the question :

Hi Garry,

Am Sat, 29 Dec 2012 16:51:07 -0500 schrieb GS:


me too, but one liners are for experts. The OP get help but he don't
understand.


Regards
Claus Busch

Claus,
I'm not surprised that you're a fan of 1-liners because your postings
usually demonstrate brevity in your code/formula samples. That said,
while I greatly appreciate/enjoy/learn from reading your posts I agree
with your statement only to a point.

In most cases OPs just want solutions and aren't really looking to
'learn' how to come up with their own solution. In some cases (which
are many) OPs evidence their interest in learning by showing us their
attempts at a solution. This doesn't discount who benefits from one
liners since these are almost never offered as the only reply in a
thread, but usually interjected after several step-by-step approaches
have been offered.

I prefer to offer the simplest approach that an OP may be able to grasp
some understanding from, and hopefully grow the learning process. I'm
sure that when a 1-liner is offered it's more for the benefit of the
more advanced reader!<g> In the case of the many who look to learn
better and more efficient ways of doing things, I'm sure the 1-liners
are well embraced for personal use.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[GS]

Ron,
That is *the most* well explained workings of a regexp sample I've ever
seen posted. Very well done!!!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[lhkittle]

I like to use regular expressions for this kind of problem. It provides a more flexible method of recognizing test patterns.

In this case, the problem can be expressed as returning strings that

Start with a digit followed by a dot followed by a space and

Ending with either another digit-dot-space sequence, or with the end ofthe string.

So the regex looks like:



Split Numbered Sentences



\d\.\s.*?(?=\d\. |$)



and is described as:



Match a single digit 0..9 «\d»

Match the character “.” literally «\.»

Match a single character that is a “whitespace character” (spaces, tabs, and line breaks) «\s»

Match any single character that is not a line break character «.*?»

Between zero and unlimited times, as few times as possible, expanding as needed (lazy) «*?»

Assert that the regex below can be matched, starting at this position (positive lookahead) «(?=\d\. |$)»

Match either the regular expression below (attempting the next alternative only if this one fails) «\d\. »

Match a single digit 0..9 «\d»

Match the character “.” literally «\.»

Match the character “ ” literally « »

Or match regular expression number 2 below (the entire group fails if this one fails to match) «$»

Assert position at the end of the string (or before the line break at the end of the string, if any) «$»



Created with RegexBuddy



As implemented in VBA code, using just A1 for the source:

======================================

Option Explicit

Sub SplitSentences()

Dim rng As Range, c As Range

Dim i As Long

Dim re As Object, mc As Object

Set rng = Range("A1")

Set re = CreateObject("vbscript.regexp")

With re

.Pattern = "\d\.\s.*?(?=\d\. |$)"

.Global = True

.MultiLine = True

End With



If re.test(rng.Text) = True Then

Set mc = re.Execute(rng.Text)

For i = 0 To mc.Count - 1

rng.Offset(rowoffset:=i + 1) = mc(i)

Next i

End If

End Sub

==============================



Of course, one could add more columns and loop through them; and should probably also clear out the cells below sufficiently. If there were a lot of data to process, and this ran slowly because of the overhead of reading/writing from the worksheet, I would dump everything into an array, work on it in the array, and then dump it back to the worksheet; but the above givesyou a an idea about a more powerful tool with which to process text strings.

Impressive code AND explaniation even though a lot of it is beyond my lurker expertise. I cpoied code & text to my archives.

Thanks a lot.

Regards,
Howard

 

[Ron Rosenfeld]

Ron,
That is *the most* well explained workings of a regexp sample I've ever
seen posted. Very well done!!!

I can take credit for the statement of the basic algorithm (Strings ending with digit-dot-space or end of the string).

As far as the dissection of the regex itself, note the final line "Created with RegexBuddy". The program itself generated that explanation. I find it incredibly useful in developing and testing regular expressions. See http://www.regexbuddy.com/

 

[GS]

Ron Rosenfeld formulated on Sunday :

I can take credit for the statement of the basic algorithm (Strings ending
with digit-dot-space or end of the string).

As far as the dissection of the regex itself, note the final line "Created
with RegexBuddy". The program itself generated that explanation. I find it
incredibly useful in developing and testing regular expressions. See
http://www.regexbuddy.com/

Thanks, Ron! I'll follow this link...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion