# Convert VBA code to useable formula?

#### MattDiptera

##### New Member
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.

VBA Code:
``````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
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
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``````

### Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

#### mikerickson

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

#### MattDiptera

##### New Member
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

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

Replies
1
Views
474
Replies
1
Views
281
Replies
15
Views
392
Replies
4
Views
130
Replies
11
Views
483

1,127,225
Messages
5,623,488
Members
415,973
Latest member
charlesbm

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back