Originally Posted by
RandyH
When the module reads ET001-300-8Y4 it returns ET0001. But, the -300-8Y is the relevant info I need. The 4 at the end does seem to denote anything useful to me if that helps.
With some minor changes, function seems to returns the correct values (I think), but, if you'll give us more info about the desired retured values, we can provide a better code because is hard to someone to follow this spaghetti code and, also, as seems, Gary prefer to going from Greece to Italy via Japan.
The code of fGetFirstChars_Nums_w with my necessarymodifications:
Code:
Public Function fGetFirstChars_Nums_w(pString As Variant) As String
'Modified by accesstos
'https://www.accessforums.net/showthread.php?t=82369&p=466687#post466687
Dim tmp As String
Dim tmpStr As String
Dim strRemStr As String
Dim strNxtChar As String
Dim strPrevChar As String
Dim strW As String
Dim bytChrLoc As Byte
Dim bytWLoc As Byte
Dim bytRemLen As Byte
Dim bytStrLen As Byte
Dim strHyphen As String
Dim cntr As Integer
Dim NoNumber As Boolean
Dim bNoW As Boolean
'set the values of the flags
NoNumber = False
bNoW = False
If Len(Trim(pString & "")) > 0 Then
'rule "B" - if the string contains a "/"
bytChrLoc = InStr(1, pString, "/")
If bytChrLoc > 0 Then
'the following code will loop until the
'previous character is numberic
FindLastNum:
'Character before the "/" must be a number
strPrevChar = Mid(pString, bytChrLoc - 1, 1)
If IsNumeric(strPrevChar) Then
tmp = Left(pString, bytChrLoc - 1)
'next check for any number following the "/"
strRemStr = right(pString, Len(pString) - bytChrLoc)
bytRemLen = Len(strRemStr)
For cntr = 1 To bytRemLen
strNxtChar = Mid(strRemStr, cntr, 1)
If IsNumeric(strNxtChar) Then
strNxtChar = Mid(strRemStr, cntr, 1)
tmp = tmp + "/" + strNxtChar
GoTo ChkForLetterW
End If
Next cntr
If cntr = bytRemLen + 1 Then
NoNumber = True
End If
ChkForLetterW:
'check to see if the letter "W" exists
'in the remaining string
bytWLoc = InStr(1, strRemStr, "W")
If bytWLoc > 0 Then
'read the "W" string from the string (no matter
' if it is a capital "W" or not it will still be
' the same character
strW = Mid(strRemStr, bytWLoc, 1)
tmp = tmp + strW
Else
bNoW = True
End If
'rule "B-2" - if there is no number following the "/" and
' there is no "W" following the "/"
'use rule "A"
If NoNumber = True And bNoW = True Then
GoTo RuleA
End If
'the rules for "B" have been applied and the string is ready
GoTo ReturnString
Else
'try to find the last number in the string
bytChrLoc = bytChrLoc - 1
GoTo FindLastNum
End If
Else
tmp = pString
End If
'rule "C" - if the string contains a "-"
bytChrLoc = InStr(1, tmp, "-")
If bytChrLoc > 0 Then
strHyphen = right(tmp, Len(tmp) - (bytChrLoc - 1))
tmp = Left(tmp, bytChrLoc - 1)
Else
strHyphen = ""
End If
RuleA:
'rule "A" - String must end with a number except when
' there is a "W" in the string
'find the last numeric value in the string
strPrevChar = right(tmp, 1)
If IsNumeric(strPrevChar) Then
GoTo ReturnString
Else
bytRemLen = Len(tmp)
'For cntr = 1 To bytRemLen
For cntr = bytRemLen To 1 Step -1
'strPrevChar = Mid(tmp, Len(tmp) - cntr, 1)
strPrevChar = Mid(tmp, cntr, 1)
If IsNumeric(strPrevChar) Then
'tmpStr = Left(tmp, Len(tmp) - cntr)
tmpStr = Left(tmp, cntr)
GoTo ChkForExistingW
End If
Next cntr
End If
ChkForExistingW:
'bytRemLen = Len(tmp) - Len(tmpStr)
strRemStr = Mid(tmp, Len(tmpStr) + 1)
bytWLoc = InStr(1, strRemStr, "W", vbTextCompare)
If bytWLoc > 0 Then
'read the "W" string from the string (no matter
' if it is a capital "W" or not it will still be
' the same character
strW = Mid(strRemStr, bytWLoc, 1)
tmp = tmpStr & strW
Else
tmp = tmpStr
End If
If strHyphen > "" Then
'tmp = tmp + strHyphen
End If
End If
ReturnString:
'fGetFirstChars_Nums_w = tmp
fGetFirstChars_Nums_w = tmp & strHyphen
End Function
The results:
With "RM1930E-025-WIL" returns "RM1930-025-WIL"
With "RM1930E/025WIL" returns "RM1930/0W"
With "XP1234AM" returns "XP1234"
With "ET001-300-8Y4" returns "ET001-300-8Y4"
With "STBK-50" returns "-50" without any error.
Cheers,
John