VBA function to Concatenate sentence up to nth Character Limit with Delimiter

Question

This is an EXCEL VBA question but related to regular expression.

I have a VBA code like below, which takes rows of string from one column and joins them together while separating them with a delimiter and outputting it in another cell. It also tries to make sure each rows of string doesn't surpass a certain maximum limit. In which case it separates not at the maximum character position, but instead in the closest white space prior to reaching the nth character (max character limit).

Sub Col_No_Blanks()
  Dim RX As Object
  Dim Col As Variant, itm As Variant
  Dim Txt As String
 
  Const Delim As String = "/"
  Const CharsBeforeDelim As Long = 10
  Const ContiguousColOfCells As String = "A2:A5"
  Const OutputCell As String = "B2"
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "(^.{1," & CharsBeforeDelim & "}(\s))(?=.+)"
  Col = Range(ContiguousColOfCells).Value
  For Each itm In Col
    If Len(itm) Then Txt = Txt & Delim & RX.Replace(itm, "$1" & Delim)
  Next itm
  Range(OutputCell).Value = Mid(Txt, Len(Delim) + 1)
End Sub

I think my problem is with the regular expression. Although it does avoid breaking a whole word and finding the closest white space to insert the delimiter, the problem is it does so even when the text is not 10 characters long.

(edit) Attached is a sample of the expected outcome. I added a char count in column B extra clarity.

Example Screen Shot

Answer 1

You don't need regex for this. Following function will join text in the selected range in a given column as desired. you can mention desired length say 20 in strLen parameter and delimiter say "//" in dChar parameter.

Option Explicit

Function JoinText(myRng As Range, strLen As Long, dChar As String) As String
Dim myRngVal As Variant, cellArr() As String
Dim cellJoinStr As String, i As Long, j As Long

myRngVal = myRng.Value
cellJoinStr = ""

For i = 1 To myRng.Cells.Count
    If myRng.Cells(i) <> "" Then
    cellJoinStr = cellJoinStr & dChar
    End If
    If myRng.Cells.Count = 1 Then
        cellArr = Split(myRng.Value, " ", , vbTextCompare)
        Else
        cellArr = Split(myRngVal(i, 1), " ", , vbTextCompare)
    End If
    For j = 0 To UBound(cellArr)
        
        If Len(cellJoinStr) + Len(cellArr(j)) _
            - InStrRev(cellJoinStr, dChar, -1, vbTextCompare) + 1 < strLen + 2 Then
            cellJoinStr = cellJoinStr & " " & cellArr(j)
            Else
            cellJoinStr = cellJoinStr & dChar & cellArr(j)
        End If
    Next j
Next i

JoinText = cellJoinStr

End Function

Not that each new row will begin with "// " (including space which you can remove with substitute function) and within cell each segment of max 20 characters will begin with "//"

Also, check Total number of characters that a cell can contain .