• Home
 · 
• Math/Dates
 · 
• incremental alphanumeric counting

incremental alphanumeric counting

incremental alphanumeric counting

Rate incremental alphanumeric counting

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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