IncDecString

Option Explicit

Attribute VB_Name = "IncrementFunctions"

Public Function IncrementTextValue(ByVal _
TextToIncrement As String, _
ByVal FieldIncrementValue As Long) As String
Dim OldValue As String
Dim NewValue As String
Dim NumberLength As Long
Dim IncrementedValue As Currency
OldValue = TextToIncrement
NewValue = StripCharactersFunc(OldValue, "")
NumberLength = Len(NewValue)

If OldValue <> NewValue Then
IncrementedValue = Val(NewValue) + 1
NewValue = PutCharactersBack(CStr(Format(IncrementedValue, _
String(NumberLength, "0"))), OldValue)
Else
NewValue = CStr(Format(Val(NewValue) + 1, String(NumberLength, "0")))
End If

IncrementTextValue = NewValue

End Function

Public Function PutCharactersBack(ByVal NewValue As String, _
ByVal OldValue As String) As String
Dim Counter As Long
For Counter = 1 To Len(OldValue)
DoEvents

If Asc(Mid(OldValue, Counter, 1)) < 48 _
Or Asc(Mid(OldValue, Counter, 1)) > 57 Then
NewValue = Mid(NewValue, 1, Counter - 1) & _
Mid(OldValue, Counter, 1) & Mid(NewValue, _
Counter, Len(NewValue))
End If
DoEvents
Next Counter
PutCharactersBack = NewValue
End Function

Public Function StripCharactersFunc(ByVal _
TheString As String, _
ByVal CharToReplaceWith As String) As String
Dim Counter As Long
For Counter = 1 To Len(TheString)
DoEvents
If Counter <= Len(TheString) Then
If Asc(Mid(TheString, Counter, 1)) < 48 _
Or Asc(Mid(TheString, Counter, 1)) > 57 Then
TheString = Mid(TheString, 1, Counter - 1) & _
CharToReplaceWith & Mid(TheString, Counter + 1, _
Len(TheString) - Counter)
Counter = Counter - 1
End If
Else
Exit For
End If

DoEvents
Next Counter
StripCharactersFunc = TheString

End Function

Inputs:
Text String to Change.
Value To Increment it by.

Returns:
Incremented String