Custom Visual Basic Function

[Maii]

Hi there,
I need a VB function like as below

If user entered A-001 then next number will be generate like below
A-002
A-003
A-004
A-005


If user entered 0001 then next number will be generate like below

0002
0003
0004
0005


If user entered X05P then next number will be generate like below

X06P
X07P
X08P
X09P


If user entered 001-ABC then next number will be generate like below

002-ABC
003-ABC
004-ABC
005-ABC


If user entered P03T04 then next number will be generate like below

P03T05
P03T06
P03T07
P03T08


And so on.....

Thanks in advance
Maii

 

[BobRodes]

I'm assuming also that if the user entered say 0xv04 then then next value would be 0xv05, right? So, read up on mid and len. Evaluate the rightmost character, continue to evaluate characters to the left until you encounter an alpha character or the beginning of the string. Once you have the numeric part of the string, use CInt to convert it to an integer. Increment the result. Add leading zeros as necessary, and patch back on the alpha part of the string in the front.

Take a stab at that, and then share the code if it isn't working, and we'll help you from there.

HTH

Bob

 

[zemp]

From what I see your 'auto' numbers can have up p to three parts. A prefix, the number and a suffix. First you need to store these three (or less) values somewhere (database, file, registry, etc). Then when you need the next number you can retrieve and increment it and store the new number for future use. Then just some concatenation and formatting to get what you want.

For example.
Pre Num Suf Concat/format

A 1 Prefix & "-" & format(number,"0000") & Suffix
1 format(number,"0000")
X 1 P Prefix & format(number,"00") & Suffix

etc.

zemp

 

[MichaelRed]

Public Function basIncrAlphN(strAlphN As String) As String

    'Michael Red.   12/21/2002
    'To Create an Incrementing A-N field with rollover
    'AAA01 to AAA99
    'AAB01 to AAB99

    Dim Idx As Integer
    Dim MyChr As String * 1
    Dim MyValStr As String
    Dim MyStrStr As String
    Dim MyValVal As Long

    'Easy on me, make user supply the last value.  "I" don't know where it is

    For Idx = 1 To Len(strAlphN)
        MyChr = Mid(strAlphN, Idx, 1)
        If (IsNumeric(MyChr)) Then
            MyValStr = MyValStr & MyChr
         Else
            MyStrStr = MyStrStr & MyChr
        End If
    Next Idx

    MyValVal = CLng(MyValStr) + 1
    If (MyValVal = 100) Then
        'Do The Rollover
        MyValVal = 1

        'Incr the String Part
        'Just put each char into Seperate Char
        MyStrStr = basIncrStr(MyStrStr)

    End If
    
    basIncrAlphN = MyStrStr & Right("00" & Trim(Str(MyValVal)), 2)

End Function

MichaelRed

 

[tpbjr]

Not exactly sure if this is what you are looking for but if it I have started it for you. Good Luck

Function GenerateNums(strIn As String, iTot) As String
'This function assumes only the patterns below in the exact pattern
'I started patterns 1 and 2
'use what I did as a template to finish
'good luck
'
'Pattern Type Value
'0002 1
'x06p 2
'A-002 3
'002-ABC 4
'P03T05 5


Dim x As Integer
Dim iPatternType As Integer
Dim sTempReturn As String
Dim iTempNum As Integer
Dim iOrigLen As Integer

'get pattern

'check for 0002 pattern 1
If IsNumeric(strIn) Then
iTempNum = Val(strIn)
sTempReturn = Format$(strIn, "0###") & vbCrLf
For x = 1 To iTot
iTempNum = iTempNum + 1
sTempReturn = sTempReturn & Format$(iTempNum, "0###") & vbCrLf
Next x
GenerateNums = sTempReturn
Exit Function
End If
'check for x06p pattern 2
If Not IsNumeric(Left(strIn, 1)) Then
If Not IsNumeric(Right(strIn, 1)) Then
iTempNum = Val(Mid(strIn, 2, 2))
sTempReturn = Left(strIn, 1) & Format$(iTempNum, "0#") & Right(strIn, 1) & vbCrLf
For x = 1 To iTot
iTempNum = iTempNum + 1
sTempReturn = sTempReturn & Left(strIn, 1) & Format$(iTempNum, "0#") & Right(strIn, 1) & vbCrLf
Next
GenerateNums = sTempReturn
Exit Function
End If
End If

'check for A-002 pattern 3
If Not IsNumeric(Left(strIn, 1)) Then 'first character is a letter
If Mid(strIn, 2, 1) = "-" Then

Exit Function
End If
End If

'check for 002-ABC pattern 4
If IsNumeric(Left(strIn, 3)) Then
If Not IsNumeric(Right(strIn, 3)) Then

Exit Function
End If
End If






For x = 1 To Len(sStr)

Next x

End Function



Thank you for all your help

http://www.besware.com

Tom

 

[tpbjr]

I forgot to tell you what the iTot parm does.
It controls the number of generations.

Of course you have to had more logic to prevent any issues such as going passed 99 or whatever.

Good Luck

Thank you for all your help

http://www.besware.com

Tom

 

[Maii]

Based on Bob Hints i wrote following function

Private Function strcvtNumber(ByVal strNumber As String, ByVal lngTotalCount As Long) As String()
Dim lngLoop As Long
Dim strChar As String
Dim lngLast As Long
Dim strRight As String
Dim strLeft As String
Dim strNumeric As String
Dim blnStop As Boolean
Dim blnPadding As Boolean
Dim strFormat As String
Dim arr() As String
ReDim arr(lngTotalCount)
For lngLoop = Len(strNumber) To 1 Step -1
strChar = Mid$(strNumber, lngLoop, 1)
If IsNumeric(strChar) Then
Exit For
End If
strRight = strChar & strRight
lngLast = lngLast + 1
Next lngLoop
For lngLoop = Len(strNumber) - lngLast To 1 Step -1
strChar = Mid$(strNumber, lngLoop, 1)
If Not IsNumeric(strChar) Then
blnStop = True
End If
If blnStop Then
strLeft = strChar & strLeft
Else
strNumeric = strChar & strNumeric
End If
Next lngLoop
If Left(strNumeric, 1) = "0" Then
blnPadding = True
strFormat = String(Len(strNumeric), "0")
End If
For lngLoop = 1 To lngTotalCount - 1
If blnPadding Then
arr(lngLoop + 1) = strLeft & Format$(Val(strNumeric) + lngLoop, strFormat) & strRight
Else
arr(lngLoop + 1) = strLeft & Val(strNumeric) + lngLoop & strRight
End If
Debug.Print arr(lngLoop + 1)
Next lngLoop
strcvtNumber = arr
End Function

Thnaks all of your help

maii

 

[BobRodes]

Nice solution, maii. The backwards for next loops are elegant, and you seem to get exactly what you want. I tried all the boundary conditions I could think of (9999, 09999, etc.), and they worked perfectly.

The only thing I would mention is that your solution never uses the first two elements of the returned string array, meaning that if you want two numbers you have to pass a 3 to lngTotalCount and evaluate array elements 2 and 3 of the array that you pass to strNumber. Not only does that waste space, it strikes me as a bit counterintuitive, since you're not passing the total count to lngTotalCount. Of course, you could have solid reasons for doing it that way, but if you don't, change this:

    For lngLoop = 1 To lngTotalCount - 1
        If blnPadding Then
            arr(lngLoop + 1) = strLeft & Format$(Val(strNumeric) + lngLoop, strFormat) & strRight
        Else
            arr(lngLoop + 1) = strLeft & Val(strNumeric) + lngLoop & strRight
        End If
        Debug.Print arr(lngLoop + 1)
    Next lngLoop

to this:

    For lngLoop = 0 To lngTotalCount - 1
        If blnPadding Then
            arr(lngLoop) = strLeft & Format$(Val(strNumeric) + lngLoop + 1, strFormat) & strRight
        Else
            arr(lngLoop) = strLeft & Val(strNumeric) + lngLoop + 1 & strRight
        End If
        Debug.Print arr(lngLoop)
    Next lngLoop

This assumes that lngTotalCount is the number of increments that you want, returned in a zero-based array.

HTH

Bob