Option Explicit

'Put code in Excel/VBAProject/Modules/ ("module1" or other name)

'UPDATED 2019 July 31 TO SHOW WORKSHEETFUNCTION SYNTAX IN VBA,
'   MAY BE BEST OPTION WHERE FUNCTION FOR SUPPORTED FUNCTIONS, WHICH INCLUDE KEY
'   FUNCTIONS INDEX, MATCH and SUMIF.


'Replicate INDEXMATCH, SUMIF/COUNTIF/AVERAGEIF, and TEXTJOIN in VBA for use from VBA.
'Show examples in which Excel Structured References can be used directly (almost) as call arguments.
'Show how a VBA FOREACH loop can use an Excel Structured Reference as an argument.

Public Function tblCalc() As Range
    Dim wksThisWorksheet As Worksheet
    Dim rsltINDEXMATCH As Variant, varINDEXMATCHResult As Variant, varFUNCMATCHResult As Variant
    Dim rsltSUMIF As Double, rsltPriceSF As Double
    Dim intRowNum As Integer, intColNum As Integer
    Dim cellValue As String, strTargetValue As String, expr As String, strQuotTargetValue As String
    Dim strRsltColName As String, strSearchColName As String, strTableName As String
    Dim strVBCONCATResult As String, concatColName As String
    Dim objCellValue As Object, objRow As Object
    Dim loTableListObject As ListObject, tblMaterial As ListObject
    Dim thisRow As ListRow
    Dim thisCol As ListColumn
    Dim searchColumn As Range, SumColumn As Range, headerRow As Range, tblMaterialRange As Range
    Dim concatColRange As Range
    
    Set wksThisWorksheet = ActiveWorkbook.Worksheets("Material") 'Initialization
    
' YOU CAN USE EXCEL STRUCTURED REFERENCE SYNTAX DIRECTLY IN VBA, by encapsulating the Structured Reference expression within the VBA EVALUATE function.
' Note that to specify text values by quoted-value within that expression, you must double-quote the value within the EVALUATE function.

' VBA Syntax for INDEXMATCH
' Excel: =INDEX(tblMaterial,MATCH("Oslo Porcelain:Bronze:Gloss:Bronze",tblMaterial[MaterialKey],0),MATCH("Price$SF",tblMaterial[#Headers],0))
    rsltINDEXMATCH = Evaluate("INDEX(tblMaterial,MATCH(""Oslo Porcelain:Bronze:Gloss:Bronze"",tblMaterial[MaterialKey],0),MATCH(""Price$SF"",tblMaterial[#Headers],0))")
    
    
'WORKSHEETFUNCTION Syntax for INDEXMATCH
    strTableName = "tblMaterial"
    strSearchColName = "MaterialKey"
    strTargetValue = "Oslo Porcelain:Bronze:Gloss:Bronze"
    strRsltColName = "Price$SF"
    Set tblMaterial = wksThisWorksheet.ListObjects(strTableName)
    Set tblMaterialRange = tblMaterial.Range
    Set searchColumn = tblMaterial.ListColumns(strSearchColName).Range
    Set headerRow = tblMaterial.HeaderRowRange
    
    With Application.WorksheetFunction
		rsltINDEXMATCH = .Index(tblMaterialRange, .Match(strTargetValue, searchColumn, 0), .Match(strRsltColName, headerRow, 0))
    
    End With
    

' VBA SYNTAX for SUMIF
' Excel: =SUMIF(tblMaterial[MaterialKey],"Imperial Next:Bardiglio:Satin:Grey Marble",tblMaterial[Price$SF])
    rsltSUMIF = Evaluate("SUMIF(tblMaterial[MaterialKey],""Imperial Next:Bardiglio:Satin:Grey Marble"",tblMaterial[Price$SF])")

' VBA SYNTAX SHOWING SUMIF SEARCH-TEXT VALUE SET OUTSIDE OF SUMIF EXPRESSION
' Excel: =SUMIF(tblMaterial[MaterialKey],strTargetValue,tblMaterial[Price$SF])
' NOTE DOUBLE QUOTES ADDED to encapsulate text value of strTargetValue
    strTargetValue = "Imperial Next:Bardiglio:Satin:Grey Marble"
    expr = "SUMIF(tblMaterial[MaterialKey], """ & strTargetValue & """,tblMaterial[Price$SF])"
    rsltSUMIF = Evaluate(expr)  'Build the expression to EVALUATE, outside of the EVALUATE call
    'OR build the EVALUATE espression in the call
    rsltSUMIF = Evaluate("SUMIF(tblMaterial[MaterialKey], """ & strTargetValue & """,tblMaterial[Price$SF])")
    
    
'WORKSHEETFUNCTION Syntax for SUMIF
    Set tblMaterial = wksThisWorksheet.ListObjects("tblMaterial")
    'strSearchColName string is set above
    'strRsltColName string is set above
    Set searchColumn = tblMaterial.ListColumns(strSearchColName).Range
    Set SumColumn = tblMaterial.ListColumns(strRsltColName).Range
    
    With Application.WorksheetFunction
		rsltSUMIF = .SumIf(searchColumn, strTargetValue, SumColumn)
    
    End With
    
    
    'OTHERWISE, put burden of quoting onto where value is set, not value user. Triple-quoted TargetValue puts a double-quote around value of TargetValue variable,
    'and that double-quoted TargetValue is concatenated within the SUMIF or other expression.
    strQuotTargetValue = """Imperial Next:Bardiglio:Satin:Grey Marble"""                                        'Sets the TargetValue, adding double-quote around the TargetValue
    rsltSUMIF = Evaluate("SUMIF(tblMaterial[MaterialKey], " & strQuotTargetValue & ",tblMaterial[Price$SF])")   'Concatenates the TargetValue into the SUMIF EVALUATE.
    
' VBA SYNTAX OF FOREACH TO SCAN A STRUCTURED TABLE COLUMN, showing how to address various elements of this operation.
    Set wksThisWorksheet = Application.Worksheets("Material")
    Set loTableListObject = wksThisWorksheet.ListObjects("tblMaterial")
    intColNum = Application.WorksheetFunction.Match("MaterialKey", loTableListObject.HeaderRowRange, 0)
    For Each thisRow In loTableListObject.ListRows
        cellValue = thisRow.Range.Cells(intColNum)
        If cellValue = "Imperial Next:Bardiglio:Satin:Grey Marble" Then
            'Act on targeted row
            rsltPriceSF = thisRow.Range.Cells(Application.WorksheetFunction.Match("Price$SF", loTableListObject.HeaderRowRange, 0))
        End If
        
    Next thisRow
    
' VBA SYNTAX SCAN DOWN ROWS TO PROCESS EACH ROW, showing how to address various elements of this operation.
    Set wksThisWorksheet = Application.Worksheets("Material")
    Set loTableListObject = wksThisWorksheet.ListObjects("tblMaterial")
    intColNum = Application.WorksheetFunction.Match("MaterialKey", loTableListObject.HeaderRowRange, 0)
    For intRowNum = 2 To loTableListObject.ListRows.Count   'Skip HeaderRowRange in Row 1
        'Now process data in the row selected by intRowNum
        cellValue = Application.WorksheetFunction.Index(loTableListObject.Range, intRowNum, intColNum)
        
    Next intRowNum
    
' VBA Function Call for INDEXMATCH emulation function
    varINDEXMATCHResult = INDEXMATCH("Material", "tblMaterial", "Imperial Next:Bardiglio:Satin:Grey Marble", "MaterialKey", "Price$SF")

' VBA Function Call for SUMIF/COUNTIF et al emulation function
    varFUNCMATCHResult = FUNCIF("SUMIF", "Material", "tblMaterial", "MaterialKey", "Marmi:Imperiali:Gloss:Grey-Tan", "Price$SF")
    
' VBA Function Call for VBTEXTJOIN emulation function
    Set wksThisWorksheet = Application.Worksheets("Material")
    Set loTableListObject = wksThisWorksheet.ListObjects("tblMaterial")

    strVBCONCATResult = VBTEXTJOIN(Chr(10), True, loTableListObject.ListColumns("MaterialKey").Range, "VBA")
    
' Call VBTEXTJOIN from Excel looks like:  =VBTEXTJOIN(Char(10),TRUE,tblMaterial[MaterialKey],"EXCEL")
    
    
'Syntax for TEXTJOIN
    '*NOTE* Total number of characters within the Evaluate argument including content of all items
    '  to concatenate MUST BE LESS THAN 255 CHARACTERS, else results in "Type mismatch" error  *NOTE*
    '  For the next statment, field "Surface" containing fewer than 255 characters was purposefully chosen.
    '  If field "MaterialKey" were chosen, the error would occur.
    
    strVBCONCATResult = Evaluate("TEXTJOIN(CHAR(10),True,tblMaterial[Surface])")
    
    
'WORKSHEETFUNCTION syntax for TEXTJOIN
    concatColName = "Surface"
    Set concatColRange = tblMaterial.ListColumns(concatColName).Range
    Set concatColRange = Range(concatColRange(2), concatColRange(concatColRange.Count)) 'Drop the column name included in concatColRange.
    
    With Application.WorksheetFunction
		strVBCONCATResult = .TextJoin(Chr(10), True, concatColRange)
    
    End With
    
    'Note use of CHR function in VBA vs CHAR function when TEXTJOIN is called from Excel User Interface.
    'TEXTJOIN character limit is 255 characters, so use of VBTEXTJOIN is more useful in many cases.
    
    
End Function

Public Function INDEXMATCH(ByVal strWksName As String, ByVal strTableName As String, ByVal rowKeyVal As Variant, ByVal strRowKeyColName As String, ByVal strColKeyName As String) As Variant
    Dim wksThisWorksheet As Worksheet
    Dim loTableListObject As ListObject
    Dim intRowNum As Integer, intColNum As Integer
    
    Set wksThisWorksheet = Application.Worksheets(strWksName)
    Set loTableListObject = wksThisWorksheet.ListObjects(strTableName)
    
    intRowNum = Application.WorksheetFunction.Match(rowKeyVal, loTableListObject.ListColumns(strRowKeyColName).Range, 0)
    intColNum = Application.WorksheetFunction.Match(strColKeyName, loTableListObject.HeaderRowRange, 0)
    
    INDEXMATCH = Application.WorksheetFunction.Index(loTableListObject.Range, intRowNum, intColNum)
    
End Function

Public Function FUNCIF(ByVal funcName As String, strWksName As String, ByVal strTableName As String, ByVal strCriteriaColName As String, ByVal strCriteriaValue As Variant, ByVal strFuncValueColName As Variant)
    Dim wksThisWorksheet As Worksheet
    Dim loTableListObject As ListObject
    Dim FuncIfStr As String
    Dim test As Variant
    
    Set wksThisWorksheet = Application.Worksheets(strWksName)
    Set loTableListObject = wksThisWorksheet.ListObjects(strTableName)
        
    If LCase(funcName) = "countif" Then
        FuncIfStr = funcName & "(" & strTableName & "[" & strCriteriaColName & "], """ & strCriteriaValue & """)"
    
    Else
        FuncIfStr = funcName & "(" & strTableName & "[" & strCriteriaColName & "], """ & strCriteriaValue & """, " & strTableName & "[" & strFuncValueColName & "])"
    
    End If
    
    FUNCIF = Evaluate(FuncIfStr)
    
End Function

Public Function VBTEXTJOIN(ByVal strCRLFChar As String, ByVal bIgnoreBlank As Boolean, ByVal rngColConcat As Range, ByVal calledFrom As String) As String
    'Replicate Excel2016 TEXTJOIN function, in VB
    Dim thisString As String
    Dim objThisString As Object
    Dim bColumnLabel As Boolean
    Dim intColConcatIndex As Integer, intColConcatIndexLast As Integer
    
    Select Case LCase(calledFrom)
        Case "excel"
            bColumnLabel = False
        Case "vba"
            bColumnLabel = True
        Case Else
            bColumnLabel = False
    End Select
    'Set bColumnLabel to ignore first element of rngColConcat if the call is from VBA.
    'rngColConcat as tablename[columnname] from Excel does not include columnname as first element.
    'rngColConcat as loTableListObject.ListColumns("MaterialKey").Range includes columnname as first element.
    
    intColConcatIndexLast = rngColConcat.Count
    ' Find last non-empty cell
    For intColConcatIndex = rngColConcat.Count To 1 Step -1
        thisString = rngColConcat(intColConcatIndex)
        If Not ((thisString = "" Or IsNull(thisString)) And bIgnoreBlank) Then
                intColConcatIndexLast = intColConcatIndex
                Exit For
        End If
        
    Next intColConcatIndex
    
    VBTEXTJOIN = ""
    For intColConcatIndex = 1 To intColConcatIndexLast
        If bColumnLabel Then
            bColumnLabel = False
        Else
            thisString = rngColConcat(intColConcatIndex)
            
            ' Ignore empty cells above first non-blank cell
            If VBTEXTJOIN = "" And Not ((thisString = "" Or IsNull(thisString)) And bIgnoreBlank) Then
                    ' Add first non-blank cell to return value
                    VBTEXTJOIN = thisString
                
            Else
                ' Add blank or non-blank cells after first non-blank cell, added value preceded by a CRLF character
                VBTEXTJOIN = VBTEXTJOIN & strCRLFChar & thisString
            
            End If
            
        End If
        
    Next intColConcatIndex
    
End Function


Public Function vbatableXLOOKUP(ByVal varLookupValue As Variant, ByVal rngTableLookupRange As Range, ByVal rngTableReturnArray As Range) As Range
' Emulation of XLOOKUP return of a column in a table, with a specified column heading.
' Call syntax in a Structured Table: vbatableXLOOKUP([@columnName], tableName[#Headers],tableName[#Data])
' Call syntax for XLOOKUP almost identical:  XLOOKUP([@columnName], tableName[#Headers],tableName[#Data])
    Dim intMatchType As Integer
    Dim intMatchColNum As Integer
    
    intMatchType = 0 ' 0 for EQ; -1 for GE; 1 for LE
    intMatchColNum = WorksheetFunction.Match(varLookupValue, rngTableLookupRange, intMatchType)
    Set vbatableXLOOKUP = rngTableReturnArray.Columns(intMatchColNum)
    
End Function