Setting up VizMap VBA module

All VizMap modules start with setting up all the parameter blocks that will be needed. All these common procedures are in the MapPublics module,  along with the names of the parameter blocks that are going to be used. I also register the name of application parameter sheets  as constants here so I can refer to them in other modules – note that the name of the parameter sheet for  cVizAppVenues is defined here. There are also some other common procedures used in geoCoding etc in this module. The key procedure here though is dSetsSetup which sets up all the parameter blocks according to the selected parameter sheet.

This is called at the beginning of a procedure which will be using these structures as follows, and from then on all access to the parameters in the workbook is ‘abstracted’  meaning that the physical locations or dimensions in the workbook do not need to be known as they can be accessed from the dSets Collection by the name referred to in the list of constants.

Dim dSets As cDataSets
    Set dSets = dSetsSetup(paramName)
    If dSets Is Nothing Then Exit Sub

other modules read additional data the same way, for example, this will get the extra parameter blocks needed to generate a vizMap application

vizdSetsSetup paramName, dSets

The full code of the MapPublics module

Option Explicit
'for more about this
' https://ramblings.mcpher.com/classes/datamanip/
'to contact me
' https://gitter.im/desktopliberation/community
'reuse of code
' https://ramblings.mcpher.com/reusing-code-from-this-site/
Public Enum eOutputMarkers
    eOutputHtml = 1
    eOutputKML = 2
End Enum

Public Const cVizAppOrders = "OrdersParameters"
Public Const cVizAppVenues = "VenuesParameters"
Public Const cVizAppPalaces = "PalacesParameters"
Public Const cVizAppOrg = "OrgParameters"
Public Const cVizAppFamily = "FamilyParameters"

Public Const cFieldID = "ID"
Public Const cFieldAddress = "Address"
Public Const cFieldValue = "Column Name"
Public Const cParamSheet = "Parameters"
Public Const cParamFields = "Fields"
Public Const cParamRules = "Column Name"
Public Const cColumnName = "Column Name"
Public Const cTransactions = "Transactions"
Public Const cMaster = "Master"
Public Const cCopyFields = "Clone"
Public Const cCloneFrom = "Clone From"
Public Const cJoin = "Join"
Public Const cTab = "Tabs"
Public Const cMeasure = "Measures"
Public Const cName = "Name"
Public Const cSheet = "Worksheet"
Public Const cBingParameters = "Bing"
Public Const cYahooParameters = "Yahoo"
Public Const cMarkers = "Markers"
Public Const cMarkerHtml = "Marker Html"
Public Const cYahooMarkerHtml = "Yahoo Marker Html"
Public Const cOviMarkerHtml = "Ovi Marker Html"
Public Const cBingMarkerHtml = "Bing Marker Html"
Public Const cMarkerViz = "Viz Marker Html"
Public Const cMarkerKML = "Marker KML"
Public Const cMapTableHtml = "Marker Html"
Public Const cMatch = "Matching Column"
Public Const cOperation = "Operation"
Public Const cChartFields = "Chart Fields"
Public Const cFilterFields = "Filter Fields"
Public Const cDictionary = "Dictionary"
Public Const cTableFields = "Table Fields"
Public Const cTwitterFields = "Twitter Fields"
Public Const cElement = "Element"
Public Const cPosition = "Position"
Public Const cShow = "Show"
Public Const cGeoCodingParameters = "GeoCodingParameters"
Public Const cImage = "Image"
Public Const cSpecificViz = "Viz Html"
Public Const cControl = "Control"
Public Const cLocalControl = "LocalControl"
Public Const cControlValue = "Setting"
Public Const cEarthMarker = "Earth Marker"
Public Const cMapsMarker = "Maps Marker"
Public Const cSpots = "Spots"
Public Const cChartType = "Chart Type"
Public iDebug As Long
Public Function dSetsSetup(paramName As String) As cDataSets

    Dim dSets As cDataSets

    ' populate the customer master
    Set dSets = New cDataSets
    With dSets
        .create
        ' get the names of all the sheets
        .init wholeSheet(paramName), , cName, True, cName

        ' create the parameter page deserialization data set
        .init wholeSheet(cGeoCodingParameters), , cParamRules, True, cParamRules
         .init wholeSheet(cGeoCodingParameters), , cControl, True, cControl
        .init wholeSheet(.DataSet(cName, True).Cell(cMaster, cSheet).toString), , cMaster, True, , True
        .init wholeSheet(.DataSet(cName).Cell(cJoin, cSheet).toString), , cJoin, , , True
        ' create the parameter page data set
        .init wholeSheet(paramName), , cParamFields, True, cParamFields
        .init wholeSheet(cGeoCodingParameters), , cBingParameters, True, cBingParameters
        .init wholeSheet(cGeoCodingParameters), , cYahooParameters, True, cYahooParameters
        .init wholeSheet(cGeoCodingParameters), , cMarkers, True, cMarkers
        .init wholeSheet(cGeoCodingParameters), , cMarkerHtml, True, cMarkerHtml
        .init wholeSheet(cGeoCodingParameters), , cYahooMarkerHtml, True, cYahooMarkerHtml
        .init wholeSheet(cGeoCodingParameters), , cOviMarkerHtml, True, cOviMarkerHtml
        .init wholeSheet(cGeoCodingParameters), , cBingMarkerHtml, True, cBingMarkerHtml
        .init wholeSheet(cGeoCodingParameters), , cMarkerKML, True, cMarkerKML

        With .DataSet(cParamFields)
        ' check that the required fields are present in the input data
          If Not dSets.DataSet(cMaster).HeadingRow.Validate(True, _
                .Cell(cFieldID, cFieldValue).toString, _
                .Cell(cFieldAddress, cFieldValue).toString) Then
            Exit Function
          End If
        End With
        
    End With
    Set dSetsSetup = dSets
End Function
Public Sub fullkeySuitableJob(job As cJobject, dr As cDataRow, _
                                spComponent As String, spSpecial As String, _
                                   Optional rDebug As Range = Nothing)
                                   
    'given a row, find the most appropriate object to populate it with
    Dim dc As cCell, pc As cCell, jo As cJobject, sName As String

    For Each dc In dr.Columns
        ' is this an interesting column ?
        sName = dr.Parent.Headings(dc.Column).toString
        With dr.Parent.Parent.DataSet(cParamRules)
            Set pc = .Cell(sName, 1)
            If Not pc Is Nothing Then
                ' it is a cell that needs filling in
                Set jo = fullkeyMappingFind(job, _
                    LCase(.Cell(sName, spComponent).toString), _
                    LCase(.Cell(sName, spSpecial).toString), _
                    rDebug)
                With dc
                    If jo Is Nothing Then
                        .Value = Empty
                    Else
                        .Value = jo.Value
                    End If
                    .Commit
                End With
            End If
        End With
    Next dc
    
End Sub

Public Function fullkeyMappingFind(job As cJobject, _
            sComponent As String, sSpecial As String, _
            Optional rDebug As Range = Nothing) As cJobject
                    
    ' given a column name, what's the best fit in the structure response from geocoding
    Dim sValue As String, jo As cJobject, jResult As cJobject, sKey As String
    Dim st As String
    
    ' these are the parameters we will work with
    sKey = LCase(job.fullKey)
    sValue = LCase(job.toString)

    ' if you need a list this will show all seen api response values
    If Not rDebug Is Nothing Then
        rDebug.Offset(iDebug, 0).Value = sKey
        rDebug.Offset(iDebug, 1).Value = job.Value
        iDebug = iDebug + 1
    End If

    If sSpecial = "fullkey" Then
        ' fullkey needs no further matching
        If sKey = sComponent Then
            Set fullkeyMappingFind = job
            Exit Function
        End If
    Else
        MsgBox ("Only full key implemented for this provider")
    End If

    ' recurse for children
    If job.hasChildren Then
        For Each jo In job.Children
            Set jResult = fullkeyMappingFind(jo, sComponent, sSpecial, rDebug)
            If Not jResult Is Nothing Then
                Set fullkeyMappingFind = jResult
                Exit Function
            End If
        Next jo
    End If

End Function
Public Function getTransactionParameters(paramName As String, dSets As cDataSets) As Boolean
    Dim sId As String

    With dSets

        sId = .DataSet(cParamFields).Cell(cFieldID, cFieldValue).toString
        .init wholeSheet(paramName), , cCopyFields, True, cCopyFields
        .init wholeSheet(.DataSet(cName).Cell(cTransactions, cSheet).toString), , cTransactions, , , True
        ' make sure we have an ID field
        With .DataSet(cTransactions)
            If Not .HeadingRow.Validate(True, sId) Then
                    Exit Function
            End If
        End With

    End With
    getTransactionParameters = True
End Function
Public Sub vizdSetsSetup(paramName As String, dSets As cDataSets)

    With dSets
        ' create the parameter page data set cVizSpecifc
        .init wholeSheet(cGeoCodingParameters), , cMarkerViz, True, cMarkerViz
        .init wholeSheet(paramName), , cSpecificViz, True, cSpecificViz
        .init wholeSheet(paramName), , cTab, True, cTab
        .init wholeSheet(paramName), , cMeasure, True, cMeasure
        .init wholeSheet(paramName), , cDictionary, True, cDictionary
        .init wholeSheet(paramName), , cElement, True, cElement
        .init wholeSheet(paramName), , cSpots, True, cSpots
        .init wholeSheet(paramName), , cLocalControl, True, cControl
    End With
    
End Sub

Public Function openNewHtml(sName As String, sContent As String) As Boolean
    Dim handle As Integer

    handle = getHandle(sName)
    If (handle <> cFailedtoGetHandle) Then
        Print #handle, sContent
        Close #handle
        openNewHtml = True
    End If

End Function
Public Sub addList(jo As cJobject, fstring As String, dr As cDataRow, key As String)

    Dim a As Variant, i As Long
    a = Split(dr.Cell(fstring).toString, ",")
    If UBound(a) >= LBound(a) Then
        With jo.add(key).AddArray.add
            For i = LBound(a) To UBound(a)
                .add , a(i)
            Next i
        End With
    End If

End Sub
Public Function pickABrowser(dSets As cDataSets, fName As String, _
                    Optional tell As Boolean = False, _
                    Optional pControl As String = cControl) As Boolean
    pickABrowser = True
    With dSets.DataSet(pControl)
        Select Case Trim(LCase(.Cell("browser", cControlValue).toString))
            Case "default"
                If Not OpenUrl(fName) Then
                    pickABrowser = False
                    MsgBox ("could not open " & fName & " using default browser")
                End If
                    
            Case "none"
                If tell Then MsgBox (fName & " has been created")
                
            Case Default
                MsgBox ("problem with browser/code parameter in block " & cControl)
        End Select
        
    End With

End Function

Questions, feedback and VizMap applications you have generated can be submitted for loading to this site via our forum.

Now let’s look at Vba to join master and transactional data