VBA/Excel/Access/Word/File Path/ListObject

Creating a Custom XML List

 
     Sub CreateXMLList()
         Dim oMyMap As XmlMap
         Dim strXPath As String
         Dim oMyList As ListObject
         Dim oMyNewColumn As ListColumn
         ThisWorkbook.XmlMaps.Add (ThisWorkbook.Path & "\Myschema.xsd")
         Set oMyMap = ThisWorkbook.XmlMaps("EmployeeSales_Map")
         Range("A1").Select
         Set oMyList = ActiveSheet.ListObjects.Add
         strXPath = "/EmployeeSales/Employee/Empid"
         oMyList.ListColumns(1).XPath.SetValue oMyMap, strXPath
         Set oMyNewColumn = oMyList.ListColumns.Add
         strXPath = "/EmployeeSales/Employee/InvoiceNumber"
         oMyNewColumn.XPath.SetValue oMyMap, strXPath
         Set oMyNewColumn = oMyList.ListColumns.Add
         strXPath = "/EmployeeSales/Employee/InvoiceAmount"
         oMyNewColumn.XPath.SetValue oMyMap, strXPath
         oMyList.ListColumns(1).Name = "EmployeeId"
         oMyList.ListColumns(2).Name = "Invoice Number"
         oMyList.ListColumns(3).Name = "Invoice Amount"
     End Sub

Inspecting a ListObject

 
" Example using various list properties 
Sub ListInfo() 
    Dim myWorksheet As Worksheet 
    Dim lo As ListObject 
    Dim lc As ListColumn 
    Set myWorksheet = ThisWorkbook.Worksheets("ListObjects") 
    Set lo = myWorksheet.ListObjects(1) 
    For Each lc In lo.ListColumns 
        Debug.Print lc.Name 
        Debug.Print lc.Index 
        Debug.Print lc.Range.Address 
        Debug.Print GetTotalsCalculation(lc.TotalsCalculation) 
    Next 
    Debug.Print lo.HeaderRowRange.Address 
    Debug.Print lo.DataBodyRange.Address 
    If Not lo.InsertRowRange Is Nothing Then 
        Debug.Print lo.InsertRowRange.Address 
    Else 
        Debug.Print "N/A" 
    End If 
    If lo.ShowTotals Then 
        Debug.Print lo.TotalsRowRange.Address 
    Else 
        Debug.Print "N/A" 
    End If 
    Debug.Print  lo.Range.Address 
    Debug.Print  lo.ShowTotals 
    Debug.Print  lo.ShowAutoFilter 
    Set lc = Nothing 
    Set lo = Nothing 
    Set myWorksheet = Nothing 
End Sub 
Function GetTotalsCalculation(xlCalc As XlTotalsCalculation) As String 
    Select Case xlCalc 
        Case Is = XlTotalsCalculation.xlTotalsCalculationAverage 
            GetTotalsCalculation = "Average" 
        Case Is = XlTotalsCalculation.xlTotalsCalculationCount 
            GetTotalsCalculation = "Count" 
        Case Is = XlTotalsCalculation.xlTotalsCalculationCountNums 
            GetTotalsCalculation = "CountNums" 
        Case Is = XlTotalsCalculation.xlTotalsCalculationMax 
            GetTotalsCalculation = "Max" 
        Case Is = XlTotalsCalculation.xlTotalsCalculationMin 
            GetTotalsCalculation = "Min" 
        Case Is = XlTotalsCalculation.xlTotalsCalculationNone 
            GetTotalsCalculation = "None" 
        Case Is = XlTotalsCalculation.xlTotalsCalculationStdDev 
            GetTotalsCalculation = "StdDev" 
        Case Is = XlTotalsCalculation.xlTotalsCalculationSum 
            GetTotalsCalculation = "Sum" 
        Case Is = XlTotalsCalculation.xlTotalsCalculationVar 
            GetTotalsCalculation = "Var" 
        Case Else 
            GetTotalsCalculation = "Unknown" 
    End Select 
End Function

To create a table from cells A1:F6, and assuming the table has column headers

 
Sub table()
    ActiveSheet.ListObjects.add(xlSrcRange, range("$A$1:$F$6"), , xlYes).name = "Table1"
End Sub