RNJarvis
9/26/2019 - 5:30 PM

Clean Invalid Name Chars

Cleans fields containing surname and forenames

'***************************************************************************
'*** Name   : CleanInvalidNameChars
'*** Purpose: Clean up the input to chars that are not alpha, "'", ".", "-",
'***          or " ".  Also removes consecutive spaces.
'*** Inputs : dirtyString
'*** Outputs:
'***
'*** Return : String
'***************************************************************************
Private Function CleanInvalidNameChars(ByVal dirtyString As String) As String
   Const ALPHAS = "[ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz]"
   Const PUNCS = "['.-]"
   Dim i As Long
   Dim strPartClean As String
   Dim strClean As String
   Dim ch As String
   Dim bFoundFirstAlpha As Boolean
   Dim arrNonConsecChars As Variant

   For i = 1 To Len(dirtyString)
      ch = Mid(dirtyString, i, 1)

      If ch Like ALPHAS Then
         strPartClean = strPartClean & ch
         bFoundFirstAlpha = True
      ElseIf bFoundFirstAlpha And (ch Like PUNCS Or ch = " ") Then
         strPartClean = strPartClean & ch
      End If
   Next

   bFoundFirstAlpha = False

   For i = Len(strPartClean) To 1 Step -1
      ch = Mid(strPartClean, i, 1)

      If ch Like ALPHAS Then
         strClean = ch & strClean
         bFoundFirstAlpha = True
      ElseIf bFoundFirstAlpha And (ch Like PUNCS Or ch = " ") Then
         strClean = ch & strClean
      End If
   Next

   arrNonConsecChars = Array(" ")

   For i = LBound(arrNonConsecChars) To UBound(arrNonConsecChars)
      ch = arrNonConsecChars(i)

      Do
        strClean = Replace(strClean, ch & ch, ch)
      Loop While InStr(1, strClean, ch & ch) > 0
   Next

   CleanInvalidNameChars = strClean
End Function