I have a Social Media project on the go (waves at https://twitter.com/librarytrustees) that is going to involve tweeting sections of existing documents.
I really hate counting characters. So I decided it was time to make myself a tool for the job.

You can see above what I have; the selected area of the original document is highlighted in varying colours, corresponding to the resulting text broken up into tweets. Additionally, I have inserted my chosen hashtag and a count of the sequence of tweets.

The length of the tweets and the Hashtag are entered in a dialog box when the Tweet Cruncher runs. This information is saved with the document, for consistency with subsequent tweets. The Tweets are not exactly the tweet length; I’ve added a bit of code to “round off” each tweet to whole words. The hashtag and sequence count are additional to the length.
And realistically, there will still be editing for content and meaning. Nevertheless, this tool should save me a ton of counting and get the project going faster.
Sub BreakIntoTweets() Dim IntSelection As Integer Dim IntPostNumb As Integer Dim IntPostCount As Integer Dim IntCharCount As Integer Dim IntTweetLength As Integer Dim rngSelectedRange As Word.Range Dim strPostText As String Dim intColourPick As Integer Dim docNewDoc As Word.Document Dim docWorkingDoc As Word.Document Dim strPropertyName As String Dim strHashTag As String Dim blnWord As Boolean Dim intActualLength As Integer Dim arrColourOptions As Variant arrColourOptions = Array(wdBrightGreen, wdPink, wdTurquoise, wdYellow) Set docWorkingDoc = ActiveDocument strPropertyName = "HashTag" strHashTag = frmStartCrunchingTweets.txtHashTag docWorkingDoc.CustomDocumentProperties(strPropertyName) = strHashTag IntTweetLength = frmStartCrunchingTweets.txtTweetLength Set rngSelectedRange = Selection.Range MsgBox rngSelectedRange.Characters.Count & " characters are selected. Including Paragraph Marks" IntSelection = rngSelectedRange.Characters.Count IntPostNumb = IntSelection / IntTweetLength MsgBox IntPostNumb rngSelectedRange.Characters(1).Select IntCharCount = 1 Documents.Add DocumentType:=wdNewBlankDocument Set docNewDoc = ActiveDocument docWorkingDoc.Activate For IntPostCount = 1 To IntPostNumb Selection.MoveRight unit:=wdCharacter, Count:=IntTweetLength - 1, Extend:=wdExtend If (Right(Selection.Text, 1) <> " ") Then blnWord = True ' extend to word If (Right(Selection.Text, 1) <> ".") Then blnWord = True If (Right(Selection.Text, 1) <> "?") Then blnWord = True If (Right(Selection.Text, 1) <> vbCr) Then blnWord = True If (Right(Selection.Text, 1) <> "!") Then blnWord = True If blnWord = True Then Selection.MoveRight unit:=wdWord, Count:=1, Extend:=wdExtend intActualLength = Selection.Characters.Count Else intActualLength = IntTweetLength End If blnWord = False strPostText = Selection.Text & frmStartCrunchingTweets.txtHashTag & " " & IntPostCount & "/" & IntPostNumb 'get rid of any hard returns strPostText = Replace(strPostText, vbCr, " ") docNewDoc.Activate Selection.TypeText (strPostText) & vbCr docWorkingDoc.Activate intColourPick = IntPostCount - (4 * Int(IntPostCount \ 4)) 'note this is why no base 1 option for array here, also \ means different than / (truncation function) Selection.Range.HighlightColorIndex = arrColourOptions(intColourPick) IntCharCount = IntCharCount + intActualLength On Error Resume Next rngSelectedRange.Characters(IntCharCount).Select '(errors on final character of selection) Next IntPostCount End Sub