View Single Post
  #13   Report Post  
Posted to microsoft.public.excel.programming
jasonsweeney[_46_] jasonsweeney[_46_] is offline
external usenet poster
 
Posts: 1
Default Parsing out text entries in a text box

For anybody following, with Tom's very generous help, the following cod
accomplishes what I expressed above:

* all of this into code for userform1:
** On Userform1 place a large textbox named "Textbox1". Also a comman
button named "commandbutton1". Also a label named "wordcount"

___________________________
Function ParseStr(sStr1 As String)
Dim varr As Variant
Dim sStr As String
Dim sChr As String
Dim sStr2 As String
Dim bLast As Boolean
Dim i As Long
varr = Empty
Dim ub As Long
sStr = sStr1 & " "
ReDim varr(1 To 1)

If Len(sStr) = 0 Then
varr(1) = ""
ParseStr = varr
Exit Function
End If
sStr2 = Mid(sStr, 1, 1)
ub = 1
For i = 2 To Len(sStr)
sChr = Mid(sStr, i, 1)
If LCase(sChr) = UCase(sChr) Then
bLast = True
ReDim Preserve varr(1 To ub)
varr(ub) = sStr2
ub = ub + 1
sStr2 = sChr
Else
If bLast Then
ReDim Preserve varr(1 To ub)
varr(ub) = sStr2
ub = ub + 1
sStr2 = sChr
bLast = False
Else
sStr2 = sStr2 & sChr
bLast = False
End If
End If
Next
ParseStr = varr
End Function


Private Sub CommandButton1_Click()
Dim sStr As String
Dim v, i As Long
sStr = textbox1.Text
v = ParseStr(sStr)
For i = LBound(v) To UBound(v)
Next
Dim rng As Range
varr = v
Set rng = Range("A1").Resize(UBound(varr, 1) - LBound(varr, 1) + 1, 1)
rng = Application.Transpose(varr)
For Each Cell In rng
Cell.Value = Application.Clean(Cell.Value)
Next
Userform1.Hide
End Sub

Private Sub textbox1_Change()
Dim varr
ReDim varr(0 To 1)
Dim sStr As String
Dim v, i As Long
sStr = textbox1.Text
v = ParseStr(sStr)
varr = v
wordcount.Caption = UBound(varr)
If UBound(varr) = 500 Then
MsgBox "You have exceeded the limit of 500 words"
ReDim Preserve varr(0 To 500)
textbox1.Text = Join(varr, " ")
End If

End Su

--
Message posted from http://www.ExcelForum.com