One way with benefits! It has reusable helper routines...
<In a standard module:>
Option Explicit
Type udtAppModes
Events As Boolean: CalcMode As Long: Display As Boolean: CallerID As
String
End Type
Public AppMode As udtAppModes
Sub ParseString()
Const sSource As String = "ParseString()"
Dim vData, v, v0, v1, v2, n&, j&, s1$
vData = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
On Error GoTo skipit
EnableFastCode sSource
For n = LBound(vData) To UBound(vData)
v0 = Split(vData(n, 1), "QTY"): s1 = ""
For j = LBound(v0) To UBound(v0)
'Get Q/O
v1 = Split(v0(0), " ")
s1 = s1 & "~" & "Q/O " & FilterString(v1(2))
RemoveTrailingSpaces s1
v1 = Split(v0(1), "ETA"): v2 = Split(v1(1), "ORDER")
'Get ETA
s1 = s1 & "~ETA " & DateValue(FilterString(v2(0), "/ :"))
RemoveTrailingSpaces s1
'Get ORDER#
v = Split(v2(1), "Q/O")
s1 = s1 & "~ORDER# " & FilterString(v(1), , False)
skipit:
Next 'j
'Split into adjacent cells in same row
v = Split(Mid(Replace(s1, " ", " "), 2), "~")
Cells(n, 2).Resize(1, UBound(v) + 1) = v
Next 'n
Cells(1, 2).Resize(, ActiveSheet.UsedRange.Columns.Count -
1).EntireColumn.AutoFit
EnableFastCode sSource, False
End Sub
Function RemoveTrailingSpaces$(TextIn$)
Dim s1$, k%
s1 = TextIn
For k = 1 To 2
If Right(s1, 1) = " " Then s1 = Mid(s1, 1, Len(s1) - 1)
Next 'j
RemoveTrailingSpaces = Replace(s1, " ", " ")
End Function
Function FilterString$(ByVal TextIn As String, _
Optional IncludeChars As String, _
Optional IncludeLetters As Boolean = True, _
Optional IncludeNumbers As Boolean = True)
' Filters out all unwanted characters in a string.
' Arguments: TextIn The string being filtered.
' IncludeChars [Optional] Keeps any characters.
' IncludeLetters [Optional] Keeps any letters.
' IncludeNumbers [Optional] Keeps any numbers.
'
' Returns: String containing only the wanted characters.
Const sSource As String = "FilterString()"
'The basic characters to always keep
Const sLetters As String = "abcdefghijklmnopqrstuvwxyz"
Const sNumbers As String = "0123456789"
Dim i As Long, CharsToKeep As String
CharsToKeep = IncludeChars
If IncludeLetters Then _
CharsToKeep = CharsToKeep & sLetters & UCase(sLetters)
If IncludeNumbers Then CharsToKeep = CharsToKeep & sNumbers
For i = 1 To Len(TextIn)
If InStr(CharsToKeep, Mid$(TextIn, i, 1)) Then _
FilterString = FilterString & Mid$(TextIn, i, 1)
Next
End Function 'FilterString()
Sub EnableFastCode(Caller$, Optional SetFast As Boolean = True)
'The following will make sure only the Caller has control,
'and allows any Caller to take control when not in use.
If AppMode.CallerID <> Caller Then _
If AppMode.CallerID <> "" Then Exit Sub
With Application
If SetFast Then
AppMode.Display = .ScreenUpdating
.ScreenUpdating = False
AppMode.CalcMode = .Calculation
.Calculation = xlCalculationManual
AppMode.Events = .EnableEvents: .EnableEvents = False
AppMode.CallerID = Caller
Else
.ScreenUpdating = AppMode.Display
.Calculation = AppMode.CalcMode
.EnableEvents = AppMode.Events
AppMode.CallerID = ""
End If
End With
End Sub
--
Garry
Free usenet access at
http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
