[VBA] Wrap text at 69 characters, with no orphans

VBAWrapText.vb

Private Function wrapText(text As String, Optional wrapLength As Integer) As String
	Dim x As Integer, newString() As String, preSplit() As String, mySplit() As String, maxWords As Long, y As Integer, finalString As String, isEnd As Boolean
	'Default wraplength to 69
	If wrapLength = 0 Then wrapLength = 69
		x = 0
		y = 0
		z = 0
		
		'Check to see if ay wrapping should be done
		If Len(text) > wrapLength Then
			'Resize the array to accomodate the number of wraps we'll need
			ReDim newString(Round((Len(text) / wrapLength), 0)) As String
			
			'Split the sentence on every space
			preSplit = Split(text)
			
			'Count the number of non-empty elements in the split
			For i = 0 To UBound(preSplit)
				If Len(Trim(preSplit(i))) > 0 Then
					z = z + 1
				End If
			Next
		
		'resize the word array, and put the non-empty elements in it
		ReDim mySplit(z - 1) As String
		z = 0
		
		For i = 0 To UBound(preSplit)
			If Len(Trim(preSplit(i))) > 0 Then
				mySplit(z) = preSplit(i)
				z = z + 1
			End If
		Next

		newString(y) = mySplit(x)
		x = x + 1
		'Get the number of words in the sentence
		maxWords = UBound(mySplit)
		While isEnd = False
			'If thereis text in this split
			If Len(mySplit(x)) > 0 Then
				'and if the length of the current string plus the new split is less than or equal to our wraplength
				If (Len(newString(y)) + Len(mySplit(x)) <= wrapLength) Then
					'add the new split to the string
					newString(y) = newString(y) & " " & mySplit(x)
					'increment the split count
					x = x + 1
				Else
					'If we're here then the next split will push us over our wrap length, so we'll create a new wrap
					y = y + 1
					'add the current split to this new wrap
					newString(y) = mySplit(x)
					'increment the split count
					x = x + 1
				End If
			Else
				'if we're here then there was a double space
				If (x = x + 1) <= maxWords Then x = x + 1 Else isEnd = True
			End If
				
			'if we're going to have an orphan, then quit
			If maxWords - x = 1 Then isEnd = True
		Wend
	
		'See if adding the next word will push us over our wrap length
		If Len(newString(y)) + Len(mySplit(x)) + Len(mySplit(x + 1)) <= wrapLength Then
			'if not, add the word
			newString(y) = newString(y) & " " & mySplit(x) & " " & mySplit(x + 1)
		Else
			'otherwise, make a new line, and add both words there
			y = y + 1
			newString(y) = mySplit(x) & " " & mySplit(x + 1)
		End If
		'Now, take the array, and make it into a regular string with returns after each array element
		finalString = newString(0)
		For x = 1 To UBound(newString)
			If Len(newString(x)) > 0 Then finalString = finalString & Chr(10) & newString(x)
		Next
		
	Else
		'if we're here then the text passed to us was not long enough to wrap
		finalString = text
	End If
	wrapText = finalString
End Function