Grid references

This page will contain useful functions converting grid references

'Written by Graham French, NBN Trust September 2008 and is supplied as is, these functions have not been extensively checked. Please check that they are converting numeric to alpha-numeric grid references correctly. Send any comments to ku.gro.nbn|atad#ku.gro.nbn|atad
'WORKS IN MICROSOFT ACCESS AND EXCEL

Numeric to alpha grid references

This function converts numeric to alpha grid references

Option Base 1**  'makes sure arrays starts at 1 and not 0
Function numeric_to_alpha_GR(GridRef As String) As String

Dim sGridref As String
Dim kmsquare As String
Dim vAlpha As Variant
Dim vNumeric As Variant, vSquare As Variant
Dim arraypos As Integer

sGridref = GridRef
vAlpha = Array("SV", "SW", "SX", "SY", "SZ", "TV", "TW", "SQ", "SR", "SS", "ST", "SU", "TQ", "TR", "SL", "SM", "SN", "SO", "SP", "TL", "TM", "SF", "SG", "SH", "SJ", "SK", "TF", "TG", "SA", "SB", "SC", "SD", "SE", "TA", "TB", "NV", "NW", "NX", "NY", "NZ", "OV", "OW", "NQ", "NR", "NS", "NT", "NU", "OQ", "OR", "NL", "NM", "NN", "NO", "NP", "OM", "NF", "NG", "NH", "NJ", "NK", "OF", "NA", "NB", "NC", "ND", "NE", "OA", "OB", "HY", "HU")
vNumeric = Array("00/", "10/", "20/", "30/", "40/", "50/", "60/", "01/", "11/", "21/", "31/", "41/", "51/", "61/", "02/", "12/", "22/", "32/", "42/", "52/", "62/", "03/", "13/", "23/", "33/", "43/", "53/", "63/", "04/", "14/", "24/", "34/", "44/", "54/", "64/", "05/", "15/", "25/", "35/", "45/", "55/", "65/", "06/", "16/", "26/", "36/", "46/", "56/", "66/", "07/", "17/", "27/", "37/", "47/", "67/", "08/", "18/", "28/", "38/", "48/", "58/", "09/", "19/", "29/", "39/", "49/", "59/", "69/", "57/", "68/")

If InStr(1, sGridref, "/", vbTextCompare) <> 0 Then
    kmsquare = Left(GridRef, 3)
    arraypos = 1
    For Each vSquare In nNumeric
        If vSquare = kmsquare Then Exit For
        arraypos = arraypos + 1
    Next
    sGridref = vAlpha(arraypos) & Right(sGridref, Len(sGridref) - 3)
End If

numeric_to_alpha_GR = sGridref

End Function

Convert to 1km grid reference

This function converts alpha-numeric grid reference to 1km grid square reference

Public Function ConvertGRto1KM(GridRef As String)

Dim strGridref As String

strGridref = GridRef

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

ConvertGRto1KM = strGridref

End Function

Convert to 2km grid reference

These two functions converts alpha-numeric grid reference to 2km grid square reference

Public Function ConvertGRto2KM(GridRef As String)

Dim strGridref As String

strGridref = GridRef

Select Case Len(strGridref)
    'BRITISH GRID REFERENCE
    Case Is = 4     '10 km grid ref then keep as 10km
        strGridref = ""
    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

Convert to 10km grid reference

This function converts alpha-numeric grid reference to 10km grid square reference

Public Function ConvertGRto10KM(GridRef As String)

Dim strTenGridref As String

strTenGridref = GridRef

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

ConvertGRto10KM = strTenGridref

End Function
Page tags: client gridreference vba
page_revision: 28, last_edited: 1246525895|%e %b %Y, %H:%M %Z (%O ago)
EditTags History Files Print Site tools+ Options
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-ShareAlike 3.0 License