Posts Tagged ‘UDF’


Reverse geocoding is the process of taking a set of GPS coordinates and turning it into the nearest available address.
Browsing through the net, I found VBA code on many websites to get GPS coordinates(latitude & longitude) from a location address but found it really hard to get a reverse geocoding in VBA.
It can be achieved using following Google API:
http://maps.googleapis.com/maps/api/geocode/json?latlng=-33.856098662,150.996315097333&sensor=false

It will return JSON, that can be parsed to get the nearest available location.
e.g.


Function GEOAddress(dblLatitude As Double, dblLongitude) As String
         
    Dim strJSON         As String
    Dim strAddress      As String
    Dim lngTemp         As Long
    Dim objXml          As Object
    Dim strUrl          As String
        
    strUrl = "http://maps.googleapis.com/maps/api/geocode/json?latlng=" & dblLatitude & "," & dblLongitude & "&sensor=false"
    Set objXml = CreateObject("Microsoft.XMLHTTP")
    With objXml
        .Open "GET", strUrl, False
        .send
        strJSON = .responseText
    End With
    Set objXml = Nothing
        
    lngTemp = InStr(1, strJSON, "formatted_address")
    strAddress = Mid(strJSON, lngTemp + 22, InStr(lngTemp, strJSON, """,") - (lngTemp + 22))
    GEOAddress = strAddress
    
End Function

Happy Coding ūüôā

VBA Trick of the Week :: Hiding Members of Enum

Posted: July 19, 2013 by Transformer in Excel, VBA
Tags: , ,

If you want to prevent a member of Enum from being displayed in VB editor’s intellisense then it can be done by prefixing them with ‘_’ and then putting them in square brackets.
e.g.

Enum Role
     AVP
     Manager
     Analyst
     [_HideMe]
End Enum

Enum

In the above image it can be seen that [ _HideMe] is not displayed in intellisense.

Filter In Arrays

Posted: May 28, 2013 by Theodoulus in Excel, VBA
Tags: , ,

Problem Statement:

Suppose, You have a data-set like the following:

Now you want to take this data in an Array and then want to filter it on the basis of ¬†column “Course”.

Solution:

We don’t have any predefined function that can filter an array so we have to code it. (more…)


While creating a subroutine we can define whether arguments will be passed ByVal  or ByRef however this behavior can be overridden as discussed below.

Let’s say we have a procedure Append which accepts an argument by reference.However at the time of calling the procedure, if argument is enclosed in parentheses then it is treated as if passed by Value.

Sub Append(ByRef strArgument As String)
    strArgument = Replace(strArgument , "by Value", "by Reference")
End Sub
'-----------------------------------------------------------------
Sub Caller()

    Dim strTemp     As String

    strTemp = "Argument passed by Value"
    Append (strTemp) ' copy of the variable is passed
    Debug.Print strTemp ' prints Argument passed by Value
    Call Append((strTemp)) 'copy of the variable is passed
    Debug.Print strTemp 'prints "Argument passed by Value"
    Append strTemp ' reference of the variable is passed
    Debug.Print strTemp 'prints "Argument passed by Reference"

End Sub 

When a function is created in Excel VBA then it can be called from a sheet as well as from another procedure in the code.If one wants to check from where the function has been called then one can use the Application.Caller.

Its behavior depends on the caller. If it is called from:

  1. Range/Cell then it returns Range
  2. Shape or some control then it returns String(Name of the shape/Control)
  3. Some procedure or function then it returns Error.

The following function can be used to check how it works.

Function GetCaller()

    Dim strCallerTyp        As String

    strCallerTyp = TypeName(Application.Caller)
    Select Case strCallerTyp
        Case "Range"
            MsgBox "Called From a Range and the address is: " & Application.Caller.Address
        Case "String"
            MsgBox "Called from a control/Shape and the name is: " & Application.Caller
        Case "Error"
            MsgBox "Error:Not called from the sheet."
    End Select

End Function

Unique List Using Dictionary Object

Posted: April 30, 2013 by Transformer in Excel, VBA
Tags: , , , ,

This function is an advanced version of  Unique Values From Data Using VBA Dictionary Object .

Following are the enhancements:

1. Now the Source data can be a Range or an Array
2. User have choice to paste data whether one wants to paste it in Columns or in Rows
3.Now It can be called from the Worksheet also and will work as an Array function

It takes the following arguments:
varSource = source data from which unique values are to be extracted.It Can be a Range or an Array
blnPaste = TRUE if you want the result to be pasted to a range, FALSE by default
blnPasteHorizontally = TRUE if you want the result to be pasted in a Row , FALSE by default
rngDest = range where the results are to be pasted
blnCase = TRUE if the list is to case-sensitive, FALSE by default. The results will be in proper case for FALSE
blnCounts = TRUE if you want to see the number of occurrences of each item as well, FALSE by default


Function varUniqueList(varSource As Variant, _
                   Optional blnPaste As Boolean = False, _
                   Optional blnPasteHorizontally As Boolean = False, _
                   Optional rngDest As Range, _
                   Optional blnCase As Boolean = True, _
                   Optional blnCounts As Boolean = False)

    Dim lngLoop                 As Long
    Dim strKey                  As String
    Dim objDictionary           As Object
    Dim varSourceTemp           As Variant
    Dim blnSheetCall            As Boolean

    Application.Volatile
    On Error Resume Next
    If TypeName(Application.Caller) = "Range" Then blnSheetCall = True
    On Error GoTo 0
    If TypeName(varSource) = "Range" Then
        If varSource.Rows.Count > 1 Then
            varSourceTemp = Application.Transpose(varSource)
        Else
            varSourceTemp = Application.Transpose(Application.Transpose(varSource))
        End If
    Else
        varSourceTemp = varSource
    End If

    If Not IsArray(varSourceTemp) Then Exit Function 'Proceeding only if the array is non-empty
    Set objDictionary = CreateObject("Scripting.Dictionary")
    With objDictionary
        For lngLoop = LBound(varSourceTemp) To UBound(varSourceTemp)
            If blnCase Then
                strKey = varSourceTemp(lngLoop)
            Else
                strKey = StrConv(varSourceTemp(lngLoop), vbProperCase)
            End If
            .Item(strKey) = .Item(strKey) + 1 'Counting occurences
        Next lngLoop
        If blnCounts Then
            varSourceTemp = Application.Transpose(Array(.keys, .items))
        Else
            varSourceTemp = Application.Transpose(Array(.keys))
        End If

        If blnSheetCall = True Then blnPasteHorizontally = Not blnPasteHorizontally
        If blnPasteHorizontally = True Then
            varUniqueList = varSourceTemp
        Else
            varUniqueList = Application.Transpose(varSourceTemp)
        End If

        'Pasting results in destination range
        If blnPaste And Not rngDest Is Nothing Then
            If blnPasteHorizontally = True Then
                rngDest.Resize(1 - blnCounts, .Count).Value = Application.Transpose(varSourceTemp)
            Else
                rngDest.Resize(.Count, 1 - blnCounts).Value = varSourceTemp
            End If
        End If
    End With
    Set objDictionary = Nothing
End Function