Alphanumeric Counter
© 2012 Mindwatering / Rocking Chair Software - Tripp Black, All Rights Reserved

%REM
	Agent TempCounter
	Created Mar 19, 2012 by Tripp W Black/Mindwatering
	Description: Counter for looping through alpha and numeric counter (e.g. AA11111)
%END REM
Option Public
Option Declare

Sub Initialize
	Dim curcount As String
	Dim formatstr As String
	curcount = "AA00000"				' starting number
	'curcount = "ZZ99990"				' test flip number
	'curcount = "1A00001"				' test bad entry
	'curcount = "AAA0001"				' test bad entry
	While Not (curcount = "ZZ99999")
		curcount = DoCountNxt(curcount, "aa00000")		' format should matching starting "number"
		Print curcount
	Wend
	
End Sub
%REM
	Function DoFormatCheck
	Description: Checks a counter based on a template formatstr
%END REM
Function DoFormatCheck(prevstr As String, formatstr As String) As Integer
	Dim tmpstr As String					' temporary working string for evaluations
	Dim formatcounter As Integer			' counter for checking format of prevstr to formatstr
	Dim fchar As String						' current character in formatstr being used for check
	Dim pchar As String						' current character in prevstr being checked
	
	If (prevstr = "") Then
		' abort
		Print "No current counter. Aborted."
		DoFormatCheck = 0
		Exit Function
	End If
	If Not (Len(prevstr)= Len(formatstr)) Then
		Print "Current Counter Length Invalid. Aborted, returning current value."
		DoFormatCheck = 0
		Exit Function
	End If
	' check characters
	For formatcounter = 1 To Len(formatstr)
		fchar = Mid(formatstr, formatcounter, 1)
		pchar = Mid(prevstr, formatcounter, 1)
		Select Case fchar
		Case "0"
			' check for number
			If Not pchar Like "[0-9]" Then
				' not a number, abort
				Print "Key Format Error. Expected " & formatstr & " ."
				DoFormatCheck = 0
				Exit Function
			End If
		Case "a"
			' check for character
			If Not pchar Like "[A-Za-z]" Then
				' not a character, abort
				Print "Key Format Error. Expected " & formatstr & " ."
				DoFormatCheck = 0
				Exit Function
			End If
		Case Else
			' error abort
			Print "Format Key Invalid. Aborted, returning current value."
			DoFormatCheck = 0
			Exit Function
	End Select
	Next formatcounter
	' got here, success!
	DoFormatCheck = 1
	Exit Function
	
End Function
%REM
	Function DoCountNxt
	Description: Checks the counter, increments the counter, and returns next value
%END REM
Function DoCountNxt(prevstr As String, formatstr As String) As String
	' prevstr = current/previous alphanumeric string to increment
	' formatstr = code template to match before incrementing
	
	' capitalize prevstr
	prevstr = UCase(prevstr)
	
	' verify format
	If (DoFormatCheck(prevstr, formatstr) = 0) Then
		' cancel, return previous value
		DoCountNxt = prevstr
		Exit Function
	End If
	
	' passed validation, increment starting at right
	Dim fchar As String				' current character in formatstr being used for increment
	Dim pchar As String				' current character in prevstr being incremented (and possibly carried to next column)
	Dim pcount As Integer			' current position being evaluated
	Dim pcharnum As Integer			' pchar as integer for counting
	Dim pcarryone As Integer		' toggle whether to carry one
	
	pcarryone = 0
	' increment
	For pcount = Len(formatstr) To 1 Step -1
		fchar = Mid(formatstr, pcount, 1)
		pchar = Mid(prevstr, pcount, 1)
		If (pcarryone = 1 Or pcount = Len(formatstr) ) Then
			' do increment
			Select Case fchar
			Case "0"
				' increment number
				pcharnum = CInt(pchar)
				If (pcharnum = 9 ) Then
					' flip and carry the 1
					pcharnum = 0
					pcarryone = 1
				Else
					If (pcarryone = 2 And pcharnum = 8) Then
						pcharnum = 0
						pcarryone = 1
					Else
						pcharnum = pcharnum + 1
						pcarryone = 0
					End If
				End If
				DoCountNxt = CStr(pcharnum) & DoCountNxt
			Case "a"
				' increment character
				If (pchar = "Z" ) Then
					' carry the 1
					DoCountNxt = "A" & DoCountNxt
					pcarryone = 1
				Else
					' incremente letter
					DoCountNxt = DoNxtLtr(pchar) & DoCountNxt
					pcarryone = 0
				End If
		End Select
		Else
			' increment done, add in rest of characters as is
			DoCountNxt = pchar & DoCountNxt
		End If
	Next pcount
	
	' done incrementing, return result

End Function

%REM
	Function DoNxtLtr
	Description: Returns next letter after current letter
%END REM
Function DoNxtLtr(prevltr As String) As String
	Select Case prevltr
		Case "A"
			DoNxtLtr = "B"
			Exit Function
		Case "B"
			DoNxtLtr = "C"
			Exit Function
		Case "C"
			DoNxtLtr = "D"
			Exit Function
		Case "D"
			DoNxtLtr = "E"
			Exit Function
		Case "E"
			DoNxtLtr = "F"
			Exit Function
		Case "F"
			DoNxtLtr = "G"
			Exit Function
		Case "G"
			DoNxtLtr = "H"
			Exit Function
		Case "H"
			DoNxtLtr = "I"
			Exit Function
		Case "I"
			DoNxtLtr = "J"
			Exit Function
		Case "J"
			DoNxtLtr = "K"
			Exit Function
		Case "K"
			DoNxtLtr = "L"
			Exit Function
		Case "L"
			DoNxtLtr = "M"
			Exit Function
		Case "M"
			DoNxtLtr = "N"
			Exit Function
		Case "N"
			DoNxtLtr = "O"
			Exit Function
		Case "O"
			DoNxtLtr = "P"
			Exit Function
		Case "P"
			DoNxtLtr = "Q"
			Exit Function
		Case "Q"
			DoNxtLtr = "R"
			Exit Function
		Case "R"
			DoNxtLtr = "S"
			Exit Function
		Case "S"
			DoNxtLtr = "T"
			Exit Function
		Case "T"
			DoNxtLtr = "U"
			Exit Function
		Case "U"
			DoNxtLtr = "V"
			Exit Function
		Case "V"
			DoNxtLtr = "W"
			Exit Function
		Case "W"
			DoNxtLtr = "X"
			Exit Function
		Case "X"
			DoNxtLtr = "Y"
			Exit Function
		Case "Y"
			DoNxtLtr = "Z"
			Exit Function
		Case Else
			' return current value, as current value is invalid
			DoNxtLtr = prevltr
	End Select
End Function