<%
    ' Copyright (c) 2009, reusablecode.blogspot.com; some rights reserved.
    '
    ' This work is licensed under the Creative Commons Attribution License. To view
    ' a copy of this license, visit http://creativecommons.org/licenses/by/3.0/ or
    ' send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California
    ' 94305, USA.

    ' http://en.wikipedia.org/wiki/Soundex

    ' Calculate soundex code for entire strings, and soundex digits for individual characters.
    ' REQUIRES: str_pad()
    function soundex(someString)
        dim result
        
        ' Rather than write a separate function to convert consonants to digits, I decided to overload the soundex function.
        if len(someString) = 1 then
            ' Calculate soundex digit for an individual character.
            select case lcase(someString)
            case "b", "f", "p", "v"
                soundex = "1"
            case "c", "g", "j", "k", "q", "s", "x", "z"
                soundex = "2"
            case "d", "t"
                soundex = "3"
            case "l"
                soundex = "4"
            case "m", "n"
                soundex = "5"
            case "r"
                soundex = "6"
            case else
                ' Remove vowels right away instead of during a later step.
                soundex = ""
            end select
        else
            ' Calculate soundex code for an entire string.
            
            ' The first letter remains intact.
            result = ucase(left(someString, 1))

            ' Replace consonants with digits and remove vowels.
            for i = 2 to Len(someString)
                result = result & soundex(mid(someString, i, 1))
            next
            
            ' Collapse adjacent identical digits into a single digit of that value.
            for i = 1 to 6
                do until inStr(result, cStr(i & i)) = 0
                    result = replace(result, cStr(i & i), cStr(i))
                loop
            next

            ' Return the starting letter and the first three remaining digits.
            ' If needed, append zeroes to make it a letter and three digits.
            soundex = str_pad(left(result, 4), 4, "0", STR_PAD_RIGHT)
        end if
    end function
%>