by Joe Mac (1 Submission)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 5th September 2010
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
incremental alphanumeric counting
VBcoders
Dim aCharacters() As String
Dim iOnes As Integer
Dim iTens As Integer
Dim iHundreds As Integer
'Dim iThousands As Integer
Dim bOnes As Boolean
Dim bTens As Boolean
Dim bHundreds As Boolean
'Dim bThousands As Boolean
Private Sub Form_Load()
Dim i As Integer
Dim aCharacters() As String
Dim rtnString As String
bOnes = True
bTens = False
bTens = False
bHundreds = False
' bThousands = False
sCharacters = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
ReDim aCharacters(Len(sCharacters) - 1)
For i = 0 To Len(sCharacters) - 1
aCharacters(i) = Mid(sCharacters, i + 1, 1)
Next
i = 0
For i = 0 To 7264
rtnString = doCounting(i, aCharacters())
Next i
End Sub
'Lpad function from - http://support.microsoft.com/kb/96458
Function Lpad(MyValue$, MyPadCharacter$, MyPaddedLength%)
PadLength = MyPaddedLength - Len(MyValue)
Dim PadString As String
For x = 1 To PadLength
PadString = PadString & MyPadCharacter
Next
Lpad = PadString + MyValue
End Function
Public Function doCounting(iPassedSeq As Integer, arr() As String) As String
Dim tmpString As String
Dim iModRet As Integer
doCounting = ""
iModRet = iPassedSeq Mod 36
Select Case iModRet
Case Is = 0
If iPassedSeq > 0 Then
bTens = True
iTens = iTens + 1
End If
'1296 = 36 ^ 2. I would imagine doing thousands like
'if iPassedSeq = (46656 * (iThousands + 1)) or something like that :)
If iPassedSeq = (1296 * (iHundreds + 1)) Then
iTens = 0
bHundreds = True
iHundreds = iHundreds + 1
End If
End Select
If bHundreds Then
tmpString = tmpString & arr(iHundreds)
End If
If bTens Then
tmpString = tmpString & arr(iTens)
End If
If bOnes Then
tmpString = tmpString & arr(iModRet)
End If
'I would like to handle the 0 on the 'sending' event rather than checking for it each time through
'this function
If iPassedSeq <> 0 Then
doCounting = Lpad(tmpString, "0", 3)
Else
doCounting = Lpad("000", "0", 3)
End If
Debug.Print (doCounting)
End Function
