# 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

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

#### 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
7
Views
391
Replies
2
Views
106
Replies
3
Views
701
Replies
3
Views
568
Replies
6
Views
469

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

1,163,652
Messages
5,832,928
Members
430,175
Latest member
Sheenamarie

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