Tuesday, 11 April 2017

Excel VBS for ConcatenateRange

Function ConcatenateRange(ByVal cell_range As Range, ByVal marks As Range) As String

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