Option Compare Database
Option Explicit
    
Public Function StripLetters(text As String) As Long
'This function extracts a number from a given text string.
'For example: C1234C1234 becomes -> 12341234.
'NOTE: The decimal point character is STRIPPED, if you want
'to include it then add it to the constant constrValidNumbers,
'change the type of the function to Double and in the final statement
'change CLng(... to CDbl(....
'
    Dim strNumber As String
    Dim strCharacter As String
    Dim i As Byte
    Const constrNumbers = "0123456789"
    
    strNumber = ""
    
    For i = 1 To Len(text)
        strCharacter = Mid(text, i, 1)
        If InStr(constrNumbers, strCharacter) > 0 Then
            strNumber = strNumber & strCharacter
        End If
    Next
    
    StripLetters = CLng(Val(strNumber))
    
End Function
    
Public Function StripNumbers(text As String) As String
'This function extracts a number from a given text string.
'For example: C1234C1234 becomes -> CC
    
    Dim strTemp As String
    Dim strCharacter As String
    Dim i As Byte
    Const constrNumbers = "0123456789"
    
    For i = 1 To Len(text)
        strCharacter = Mid(text, i, 1)
        If InStr(constrNumbers, strCharacter) = 0 Then
            strTemp = strTemp & strCharacter
        End If
    Next
    
    StripNumbers = strTemp
    
End Function    
    
Public Function FirstNumber(strText As String) As Double
'Returns the first number in a given text string, if no number exists,
'then a 0 is returned.  IE: "123 Text" becomes 123
'NOTE: The Decimal IS considered a number character in this function
    
    Dim strCharacter As String
    Dim i As Integer
    Dim x As Integer
    Dim intStartAt As Integer
    Dim intEndAt As Integer
    Const constrNumbers = "012345467879."
    
    For i = 1 To Len(strText)
        strCharacter = Mid(strText, i, 1)
        If InStr(1, constrNumbers, strCharacter) > 0 Then
            intStartAt = i
            If i < Len(strText) Then
                For x = i To Len(strText)
                    strCharacter = Mid(strText, x, 1)
                    If InStr(1, constrNumbers, strCharacter) = 0 Then
                        intEndAt = x - 1
                        Exit For
                    End If
                Next x
                If x = Len(strText) + 1 And intEndAt = 0 Then
                    intEndAt = x - 1
                End If
            Else
                intEndAt = intStartAt
            End If
        End If
        
        If intEndAt > 0 Then
            Exit For
        End If
    Next i
    
    If intEndAt > 0 And intStartAt > 0 Then
        FirstNumber = CDbl(Mid(strText, intStartAt, intEndAt - intStartAt + 1))
    Else
        FirstNumber = 0
    End If
    
End Function
    
Public Function HowMany(strCharacter As String, strSearchString As String) As Byte
'Searchs through the strSearchString for the strCharacter and returns the number
'of times that character occurs
    
    Dim byteCount As Byte
    Dim x As Integer
    
    byteCount = 0
        
    For x = 1 To Len(strSearchString)
        If Mid(strSearchString, x, 1) = strCharacter Then
            byteCount = byteCount + 1
        End If
    Next x
    
    HowMany = byteCount
    
End Function
    
Public Function RemSpecial(strText, ParamArray strExeptions()) As String
'Removes special characters from a string.  Special characters are those
'characters that are not in the set A-Z, a-z, 0-9, .
'If you do not want a particular special character removed, pass it to the
'function in the strExceptions() array.
    
    Dim x As Integer
    Dim y As Integer
    Dim strX As String
    Dim strStrippedText As String
    
    'Ascii code ranges
    Const conNumberRangeStart = 48
    Const conNumberRangeStop = 57
    Const conCapLettersStart = 65
    Const conCapLettersStop = 90
    Const conSmallLettersStart = 97
    Const conSmallLettersStop = 122
    
    'Start with the string
    strText = Nz(Trim(strText))
    
    'Loop through each digit of the string to determine if it falls into the
    'Ascii ranges OR is an exception
    For x = 1 To Len(strText)
    
        strX = Mid(strText, x, 1)
        
        Select Case Asc(strX)
        
            Case conNumberRangeStart To conNumberRangeStop, _
                 conCapLettersStart To conCapLettersStop, _
                 conSmallLettersStart To conSmallLettersStop
                
                strStrippedText = strStrippedText & strX
        
            Case Else
            
                For y = 0 To UBound(strExeptions())
                    If strX = strExeptions(y) Then
                        strStrippedText = strStrippedText & strX
                    End If
                Next y
                
        End Select
    Next x
    
    RemSpecial = strStrippedText
    
End Function