Dim cell As Range
Dim coursesString As String
Dim cellArray As Variant
Dim cellArray2 As Variant
Dim i As Long, j As Long
Dim CoursesArray As New Collection
cellArray = cell_range.Value
cellArray2 = marks.Value
' Add courses into array if there's mark
For i = 1 To UBound(cellArray, 1)
For j = 1 To UBound(cellArray, 2)
If Len(cellArray(i, j)) <> 0 Then
' check if there's mark and add course to courses array
If cellArray2(i, j) <> 0 Then
CoursesArray.Add (cellArray(i, j))
End If
End If
Next
Next
'return string of courses delimited with new line character
For Each CourseId In SortCollection(CoursesArray)
coursesString = coursesString & (CourseId & Chr(10))
Next CourseId
' return result
ConcatenateRange = coursesString
End Function
' sort collection
Function SortCollection(Optional ByVal listToSort As Collection) As Collection
Dim list As Collection
Dim vItm As Variant
Dim i As Long, j As Long
Dim vTemp As Variant
Set list = listToSort
'Two loops to bubble sort
For i = 1 To list.Count - 1
For j = i + 1 To list.Count
If list(i) > list(j) Then
'store the lesser item
vTemp = list(j)
'remove the lesser item
list.Remove j
're-add the lesser item before the
'greater Item
list.Add vTemp, vTemp, i
End If
Next j
Next i
' return result
Set SortCollection = list
End Function
Use: =ConcatenateRange($I$3:$K$3,I67:K67)
No comments:
Post a Comment