Alternative FilterXML
approach
I'm demonstrating an alternative via FilterXML()
function in three steps only:
- a) define the data range - see help function
getRange()
- b) get student name(s) via FilterXML()
- c) return the expected (unique) result (after an exceptions check for several or no findings)
Methodical hints
The FilterXML() function (available since vers. 2013+) requires the following arguments:
1)
a wellformed xml content string (roughly comparable to a html tags structure) - *see help function wellformed()*
,
2)
a XPath expression defining here the searched node (i.e. <i>..</i>
) at any hierarchy level //i
as well as
juxtaposed "And"
conditions in brackets [..]
defining the wanted value contents of the immediately following
neighbour nodes.
Results in a string like <r><i>Amy</i><i>1</i><i>22</i><i>Richard</i><i>1</i><i>17</i>...</r>
where the freely chosen name of <r>
stands for the document element, i.e. root, <i>
for item.
Further link @JvDV 's encyclopaedia like collection of FilterXML examples
Example of a user defined function GetStudentName()
Option Explicit ' declaration head of code module
Public Function GetStudentName(Class, StudentID) As String
'a) define full data range
Dim DataRange As Range
Set DataRange = GetRange(ThisWorkbook.Worksheets("From"))
'b) get student name(s) via FilterXML() based on wellformed content & XPath
Dim tmp
tmp = Application.FilterXML( _
wellformed(DataRange), _
"//i[following::*[1]='" & Class & "']" & _
"[following::*[2]='" & StudentID & "']")
'c) return result string (after exceptions check for safety's sake)
GetStudentName = check(tmp)
End Function
Help function wellformed()
The following help function builds a so-called "wellformed" xml string using the ►TextJoin()
function available since versions 2019+. -
It is easy, however to rewrite this function based on loops over all values in a datafield array based on the given range.
Function wellformed(rng As Range) As String
'Purp: return wellformed xml content string
' (based on range input of several columns)
'Note: 1st argument of FilterXML() function
wellformed = "<r><i>" & WorksheetFunction.TEXTJOIN("</i><i>", True, rng) & "</i></r>"
End Function
Help function check()
Provides for possible exceptions (i.e. of 1 or several findings),
as OP awaits only unique findings. Note that the late bound Application.FilterXML
allows to analyze these exception without On Error
handling.
Function check(tmp) As String
'Purp: return Student Name as unique result and expected default, or
' check exceptions zero or several findings (without On Error handling)
'a) provide for exceptions
If TypeName(tmp) = "Variant()" Then ' found several elements
tmp = UBound(tmp) & " elems: " & Join(Application.Transpose(tmp), ",")
ElseIf IsError(tmp) Then ' found no element at all
tmp = "?"
End If
'b) return function result
check = tmp
End Function
Help function GetRange()
Simply returns the full data range of a referenced worksheet (here: "From"
).
Furthermore the function allows to define optional column boundaries,
which might be used in other projects, too.
Function GetRange(ws As Worksheet, _
Optional ByVal col = "A", _
Optional ByVal col2 = "C", _
Optional ByVal StartRow& = 2) As Range
'Purp: set full data range by calculation of last row in start column
'Note: assumes 3 columns range A:C by default (optional arguments)
'a) identify start and end column
If IsNumeric(col) Then col = Split(ws.Cells(1, col).Address, "$")(1)
If IsNumeric(col2) Then col2 = Split(ws.Cells(1, col2).Address, "$")(1)
'b) get last row in start column
Dim LastRow As Long
LastRow = ws.Range(col & Rows.Count).End(xlUp).Row
'c) return full range
Set GetRange = ws.Range(col & StartRow & ":" & col2 & LastRow)
End Function