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

```