Convert VBA code to useable formula?

[MattDiptera]

Hi

Would it be possible to convert a VBA code into a function that i can insert into a cell? Struggling to get my head around VBA. In a nut shell this code should convert a grid reference in a Tetrad (2x2km). I have managed to create the formula to create a Hectad (10x10km) and also a Monad (1x1km) via string manipulation however a Tetrad ends in a letter instead of just knocking off x and y numbers so is a bit more complicated.

Here is the VBA code (Written by Graham French, NBN Trust September 2008), thanks in advance if anyone is able to offer an insight in how i do this.

Public Function ConvertGRto2KM(GridRef As String)

Dim strGridref As String

strGridref = GridRef

Select Case Len(strGridref)
    'BRITISH GRID REFERENCE
    Case Is = 4
       'British 10 km grid ref return blank
       If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid(strGridref, 2, 1), vbTextCompare) <> 0 Then
            strGridref = ""
        Else
        'Irish Tetrad
        strGridref = strGridref
       End If
    Case Is = 6     '1km
        strGridref = Left(strGridref, 3) & Mid(strGridref, 5, 1) & _
                    Get_Letter(Mid(strGridref, 4, 1) & Right(GridRef, 1))
    Case Is = 8     '100m
        strGridref = Left(strGridref, 3) & Mid(strGridref, 6, 1) & _
                    Get_Letter(Mid(strGridref, 4, 1) & Mid(GridRef, 7, 1))
    Case Is = 10    '10m
       strGridref = Left(strGridref, 3) & Mid(strGridref, 7, 1) & _
                    Get_Letter(Mid(strGridref, 4, 1) & Mid(GridRef, 8, 1))
    Case Is = 12    '1m
          strGridref = Left(strGridref, 3) & Mid(strGridref, 8, 1) & _
                    Get_Letter(Mid(strGridref, 4, 1) & Mid(GridRef, 9, 1))
    'IRISH GRID REFERENCE
    Case Is = 3     '10 km
        strGridref = ""
    Case Is = 5
        'British Tetrad
        If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid(strGridref, 2, 1), vbTextCompare) <> 0 Then
            strGridref = strGridref
        Else
        'Irish 1km
             strGridref = Left(strGridref, 2) & Mid(strGridref, 4, 1) & _
                    Get_Letter(Mid(strGridref, 3, 1) & Right(GridRef, 1))
        End If
    Case Is = 7    '100m
        strGridref = Left(strGridref, 2) & Mid(strGridref, 5, 1) & _
                    Get_Letter(Mid(strGridref, 3, 1) & Mid(GridRef, 6, 1))
    Case Is = 9    '10m
        Case Is = 10    '10m
       strGridref = Left(strGridref, 2) & Mid(strGridref, 6, 1) & _
                    Get_Letter(Mid(strGridref, 3, 1) & Mid(GridRef, 7, 1))
    Case Is = 11    '1m
         strGridref = Left(strGridref, 2) & Mid(strGridref, 7, 1) & _
                    Get_Letter(Mid(strGridref, 3, 1) & Mid(GridRef, 8, 1))
    Case Else       'Do not convert
        strGridref = ""
End Select

ConvertGRto2KM = strGridref

End Function

Public Function Get_Letter(Position As String) As String

Select Case Position
    Case "00", "10", "01", "11"
        Get_Letter = "A"
    Case "20", "30", "21", "31"
        Get_Letter = "F"
    Case "40", "50", "41", "51"
        Get_Letter = "K"
    Case "60", "70", "61", "71"
        Get_Letter = "Q"
    Case "80", "90", "81", "91"
        Get_Letter = "V"
    Case "02", "12", "03", "13"
        Get_Letter = "B"
    Case "22", "32", "23", "33"
        Get_Letter = "G"
    Case "42", "52", "43", "53"
        Get_Letter = "L"
    Case "62", "72", "63", "73"
        Get_Letter = "R"
    Case "82", "92", "83", "93"
        Get_Letter = "W"
    Case "04", "14", "05", "15"
        Get_Letter = "C"
    Case "24", "34", "25", "35"
        Get_Letter = "H"
    Case "44", "54", "45", "55"
        Get_Letter = "M"
    Case "64", "74", "65", "75"
        Get_Letter = "S"
    Case "84", "94", "85", "95"
        Get_Letter = "X"
    Case "06", "16", "07", "17"
        Get_Letter = "D"
    Case "26", "36", "27", "37"
        Get_Letter = "I"
    Case "46", "56", "47", "57"
        Get_Letter = "N"
    Case "66", "76", "67", "77"
        Get_Letter = "T"
    Case "86", "96", "87", "97"
        Get_Letter = "Y"
    Case "08", "18", "09", "19"
        Get_Letter = "E"
    Case "28", "38", "29", "39"
        Get_Letter = "J"
    Case "48", "58", "49", "59"
        Get_Letter = "P"
    Case "68", "78", "69", "79"
        Get_Letter = "U"
    Case "88", "98", "89", "99"
        Get_Letter = "Z"
End Select

End Function

 

[mikerickson]

Have you tried putting =ConvertGRto2KM(A1) in a cell and putting values in A1.

 

[MattDiptera]

Have you tried putting =ConvertGRto2KM(A1) in a cell and putting values in A1.

Doesn't appear to be a function, the Tetrad system is not a widely used system so a ready to roll function isn't available "A tetrad is a 2km x 2km square, given a letter code as shown below. So tetrad SW41A is made up of the four 1km squares SW4010, SW4011, SW4110 and SW4111."

 

[mikerickson]

If you put the code from the OP into a normal module of the workbook in quesiton, that formula should return something.