Best methods to reference a user function in a macro - excel

Question

Afternoon,
I currently have this User Function saved:
Function AlphaNumericOnly(strSource As String) As String
Dim i As Integer
Dim strResult As String
For i = 1 To Len(strSource)
Select Case Asc(Mid(strSource, i, 1))
Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space
strResult = strResult & Mid(strSource, i, 1)
End Select
Next
AlphaNumericOnly = strResult
End Function
I call this User Function in some macros that I run (checking that it is open in the macro). The issue I'm having is when I need to share a macro that references this with another user.
I could of course copy the User Function and send that along with a copy of the macro, they could then save it locally and adjust the macro to check their local copy is open. But this seems quite long winded.
Could anybody offer any suggestions? I am wondering if I could somehow embed the User Function in the macro, or store it centrally some how. Some web searching and asking around has drawn a blank on this one.
Thank you.
Please see the complete macro along with the user function at the end:
Option Explicit
Public Const csFORMULA = "=concatenate(""AGSBIS"",IF(I2=0,"""",CONCATENATE(UPPER(AlphaNumericOnly(LEFT(I2,3))),UPPER(AlphaNumericOnly(RIGHT(I2,3))))),IF(O2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(O2,""0"","""")))),IF(R2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(R2,""0"","""")))),IF(W2=0,"""",UPPER(AlphaNumericOnly(SUBSTITUTE(W2,""0"","""")))),IF(AC2=0,"""",AlphaNumericOnly(SUBSTITUTE(AC2,""0"",""""))),IF(AD2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AD2,""-"",""X""),""."",""Y""),""0"",""Z"")),IF(AF2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AF2,""-"",""X""),""."",""Y""),""0"",""Z"")),IF(AH2=0,"""",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(AH2,""-"",""X""),""."",""Y""),""0"",""Z"")))"
Sub AgeasBIS()
Dim lr As Long
Dim cl As Range
Dim Rng As Range
Dim mssg As String
Dim WS As Worksheet
Dim SaveToDirectory As String
Dim DateFormat As String
Dim StatementName As String
Dim Organisation As String
Dim ErrorMessage As String
Dim ErrorMessageTitle As String
Dim CompleteMessage As String
Dim CompleteMessageTitle As String
Dim UserFunctionsLocation As String
Dim SaveLocation As String
DateFormat = Format(CStr(Now), "yyyy_mm_dd_hhmmss_")
ErrorMessageTitle = "Invalid Date Format"
ErrorMessage = "There are invalid date value(s) in the following cell(s). Please check these cells."
CompleteMessageTitle = "Statement Preparation"
CompleteMessage = "Statement preparation is complete. Your file has been saved and will be processed as part of the next scheduled upload."
StatementName = "age_bts"
Organisation = "BTS"
' save locations
'*location of the old user function* UserFunctionsLocation = "C:\Users\user.name\AppData\Roaming\Microsoft\AddIns\UserFunctions.xla"
SaveLocation = "S:\MI\gre_cac\statement_feeds\waiting_to_upload\"
Set WS = ActiveSheet
Application.ScreenUpdating = False
Workbooks.Open Filename:=UserFunctionsLocation
'clears any formats from the sheet
With WS
.Cells.ClearFormats
End With
'standardises all fonts
With WS.Cells.Font
.Name = "Calibri"
.Size = 10
.Bold = False
End With
With WS
'cleans all non_printable characters from the data (excluding date columns) & removes "'" & ","
'trims the insurer comments field to ensure it is a maximum of 500 characters
lr = .Range("I" & Rows.Count).End(xlUp).Row
Set Rng = Union(.Range("C2:AA" & lr), .Range("AD2:AO" & lr), .Range("AM2:AM" & lr))
For Each cl In Rng
If cl.Column = 39 Then 'column AM gets Left() truncation as well
cl = Left(WorksheetFunction.Trim(WorksheetFunction.Clean(cl.Value)), 500)
cl = WorksheetFunction.Substitute(cl.Value, "'", "")
cl = WorksheetFunction.Substitute(cl.Value, ",", "")
Else
cl = WorksheetFunction.Trim(WorksheetFunction.Clean(cl.Value))
cl = WorksheetFunction.Substitute(cl.Value, "'", "")
cl = WorksheetFunction.Substitute(cl.Value, ",", "")
End If
Next cl
'format invoice_date, effective_date & spare_date to dd/mm/yyyy
Union(.Range("AB1:AB" & lr), .Range("AC1:AC" & lr), .Range("AP1:AP" & lr)).NumberFormat = "dd/mm/yyyy"
'formats all numerical fields to "0.00"
Union(.Range("AD2:AL" & lr), .Range("AO2:AO" & lr)).NumberFormat = "0.00"
'add the statement name
Range("A2:A" & lr).FormulaR1C1 = StatementName
'add the organisation name
Range("D2:D" & lr).FormulaR1C1 = Organisation
'adds the formula to generate the unique key (from the declared constant)
Range("B2:B" & lr).Formula = csFORMULA
Range("B2:B" & lr) = Range("B2:B" & lr).Value
'auto-fit all columns
With WS
.Columns.AutoFit
End With
'checks that only date values as present in the invoice_date, effective_date & spare_date
Set Rng = Union(.Range("AB2:AB" & lr), .Range("AC2:AC" & lr), .Range("AP2:AP" & lr))
For Each cl In Rng
If Not IsDate(cl.Value) And Not IsEmpty(cl) Then _
mssg = mssg & cl.Address(0, 0) & Space(4)
Next cl
End With
'If non-date values are found display a message box showing the cell locations
If CBool(Len(mssg)) Then
MsgBox (ErrorMessage & Chr(10) & Chr(10) & _
mssg & Chr(10) & Chr(10)), vbCritical, ErrorMessageTitle
'Otherwise display a message that the statement preparation is complete
Else
MsgBox CompleteMessage, , CompleteMessageTitle
End If
'save location for the .csv
SaveToDirectory = SaveLocation
'uses the set dateformat and save lovation
WS.SaveAs SaveToDirectory & DateFormat & StatementName, xlCSV
Set Rng = Nothing
Set WS = Nothing
Application.ScreenUpdating = True
ActiveWorkbook.Close SaveChanges:=False
End Sub
Function AlphaNumericOnly(strSource As String) As String
Dim i As Integer
Dim strResult As String
For i = 1 To Len(strSource)
Select Case Asc(Mid(strSource, i, 1))
Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space
strResult = strResult & Mid(strSource, i, 1)
End Select
Next
AlphaNumericOnly = strResult
End Function

Answer 1

Working through the comments:
Try adding a tempValue before the Select Case
Function AlphaNumericOnly(strSource As String) As String
Dim i As Integer
Dim strResult As String
Dim tempValue As Integer
For i = 1 To Len(strSource)
tempValue = Asc(Mid(strSource, i, 1))
Select Case tempValue
Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space
strResult = strResult & Mid(strSource, i, 1)
End Select
Next
AlphaNumericOnly = strResult
End Function

Answer 2

Using Regular Expressions offers a shorter more efficient solution then examining each character:
Function AlphaNumericOnly(strIn) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.ignorecase = True
.Pattern = "[^\w]+"
AlphaNumericOnly = .Replace(strIn, vbNullString)
End With
End Function