Function JoinIf(ByVal Delimiter As String, ByVal CriteriaArray, ByVal Criteria, Optional ByVal TargetArray) As String
Dim aTmpCrit, aTmpDes, tmp1, tmp2, arr(), dic As Object
Dim bComp As Boolean, Chk As Boolean
Dim i As Long, j As Long, k As Long, dTmpVal As Double
Set dic = CreateObject("Scripting.Dictionary")
If IsMissing(TargetArray) Then TargetArray = CriteriaArray
aTmpCrit = ConvertTo1DArray(CriteriaArray)
aTmpDes = ConvertTo1DArray(TargetArray)
If (Not IsArray(aTmpCrit)) Or (Not IsArray(aTmpDes)) Then Exit Function
On Error Resume Next
bComp = (InStr("<>=", Left(Criteria, 1)) > 0)
For i = LBound(aTmpDes) To UBound(aTmpDes)
tmp1 = aTmpCrit(i): tmp2 = aTmpDes(i)
If TypeName(tmp1) <> "Error" Then
If TypeName(tmp2) <> "Error" Then
If bComp And Len(Criteria) Then
dTmpVal = CDbl(aTmpCrit(i))
If Evaluate(dTmpVal & Criteria) Then dic.Add tmp2, ""
Else
If (Left(Criteria, 1) = "!") Then
If Not (UCase(tmp1) Like UCase(Mid(Criteria, 2, Len(Criteria)))) Then dic.Add tmp2, ""
Else
If (UCase(tmp1) Like UCase(Criteria)) Then dic.Add tmp2, ""
End If
End If
End If
End If
Next
If dic.Count Then
arr = dic.Keys
JoinIf = Join(arr, Delimiter)
End If
End Function
Private Function ConvertTo1DArray(ByVal SourceArray)
Dim aTmp, Item, arr()
Dim n As Long
On Error Resume Next
aTmp = SourceArray
If Not IsArray(aTmp) Then aTmp = Array(aTmp)
For Each Item In aTmp
n = n + 1
ReDim Preserve arr(1 To n)
arr(n) = Item
Next
ConvertTo1DArray = arr
End Function
