1

I have code which joins some strings.

For example:

Before enter image description here

Now enter image description here

I want to see enter image description here

Error: enter image description here

Easy example enter image description here

The problem is that the unedited string has italic words, but when I try to join this string, italic words become without this font, how I should edit my code?

Sub MergeText()

Dim strMerged$, r&, j&, i&, uneditedColumn As Long, resultColumn As Long
With ThisWorkbook.Worksheets("Sheet1") 'Change sheet name if needed
    uneditedColumn = 1 ' Column number which need to edit !!! uneditedColumn must not be equal resultColumn
    resultColumn = 3 ' Column number where need to put edited text
    r = 1
    Do While True
        If Cells(r, uneditedColumn).Characters(1, uneditedColumn).Font.Bold Then
            strMerged = "": strMerged = Cells(r, uneditedColumn)
            r = r + 1
            While (Not Cells(r, uneditedColumn).Characters(1).Font.Bold) And Len(Cells(r, uneditedColumn)) > 0
                strMerged = strMerged & " " & Cells(r, uneditedColumn)
                r = r + 1
            Wend
            i = i + 1: Cells(i, resultColumn) = strMerged
            Cells(i, resultColumn).Characters(1, InStr(1, strMerged, ".", vbTextCompare)).Font.Bold = True
        Else
            Exit Do
        End If
    Loop
End With
End Sub
Anthony14
  • 105
  • 6
  • 1
    That outer loop looks dangerously easy to turn into an infinite loop. Consider rewriting it into a `For...Next` loop. – Mathieu Guindon Jun 25 '19 at 16:00
  • Also you mean to be working off `ThisWorkbook.Worksheets("Sheet1")`, but the unqualified `Cells` calls sprinkled everywhere are all referring to whatever worksheet is currently the `ActiveSheet`, which will eventually cause problems/surprises; add a `.` dot operator in front of them (e.g. `.Cells(...)`), to use the `With` block object as a qualifier. – Mathieu Guindon Jun 25 '19 at 16:01
  • Thanks, but can you help me with this problem? – Anthony14 Jun 25 '19 at 16:08
  • 1
    Because you're dealing with formatted text in a cell -- rich formatted text (RFT) -- you need to handle it without destroying the formatting. Your statement `strMerged = Cells(r, uneditedColumn)` implies that you're using the `.Value` property of the cell, so most (none?) of the formatting will not transfer to the string. The best way to retain the formatting is to use the clipboard, as [this answer](strMerged = Cells(r, uneditedColumn)) shows, to build your solution around that idea. – PeterT Jun 25 '19 at 16:14
  • @PeterT - Not sure which answer you are referring to, can you post the link? – cybernetic.nomad Jun 25 '19 at 16:33
  • Well, it certainly helps if I keep track of what I have in the clipboard :) I was referring to [this answer](https://stackoverflow.com/a/1747886/4717755), but I also ran across [another answer](https://stackoverflow.com/a/48605635/4717755) working with RFT data that uses a .NET RichTextBox. So there are a couple different possibilities. – PeterT Jun 25 '19 at 16:48

1 Answers1

1

Ok, that was very fun. Code first, talk later:

Public Sub MergeAndFormat()

    Const originalColumn As Long = 1
    Const formattedColumn As Long = 3

    Dim lastRow As Long
    lastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row

    Dim currentEntry As Long

    Dim currentRow As Long
    For currentRow = 1 To lastRow

        Dim currentCell As Range
        Set currentCell = Sheet1.Cells(currentRow, originalColumn)

        Dim currentText As String
        currentText = currentCell.Value
        ' ensure we have a space at the end of the line
        If Right$(currentText, 1) <> " " Then currentText = currentText & " "

        Dim isNewEntry As Boolean 'new entry if first char is bold
        isNewEntry = currentCell.Characters(1, 1).Font.Bold

        Dim currentCharOffset As Long
        Dim currentEntryText As String
        If isNewEntry Then
            currentEntry = currentEntry + 1
            currentEntryText = currentText
            currentCharOffset = 1
        Else
            currentCharOffset = Len(currentEntryText) + 1
            currentEntryText = currentEntryText & currentText
        End If

        Dim entryCell As Range
        Set entryCell = Sheet1.Cells(currentEntry, formattedColumn)
        If isNewEntry Then entryCell.Value = vbNullString

        'append the source characters, without losing formatting in the entryCell
        entryCell.Characters(currentCharOffset + 1).Insert currentText

        Dim currentIndex As Long
        For currentIndex = 1 To currentCell.Characters.Count

            entryCell.Characters(currentCharOffset + currentIndex - 1, 1).Font.Bold = currentCell.Characters(currentIndex, 1).Font.Bold
            entryCell.Characters(currentCharOffset + currentIndex - 1, 1).Font.Italic = currentCell.Characters(currentIndex, 1).Font.Italic
            entryCell.Characters(currentCharOffset + currentIndex - 1, 1).Font.Underline = currentCell.Characters(currentIndex, 1).Font.Underline
            entryCell.Characters(currentCharOffset + currentIndex - 1, 1).Font.Strikethrough = currentCell.Characters(currentIndex, 1).Font.Strikethrough

        Next

    Next

End Sub

The entire loop logic was obscured by single-letter variable names, data types involved were obscured with type hint characters, and the intent of the variables was obscured because the meaning of a variable changed depending on what line of code you were looking at (e.g. uneditedColumn with a value of 1 coincidentally making sense as a Length argument for the Range.Characters property.

So I burned everything to the ground, and rewrote the whole logic.

We know where the "original" text begins, and where it ends - we don't need a near-infinite Do While loop: instead we figure out what the lastRow is, and we use a For...Next loop that starts at the top and finishes at whatever the lastRow is, using currentRow as out counter.

Since we use currentRow for counting where we're at in the original column, we'll use currentCell for the Range object representing that particular "current cell", and currentText will hold the string value of that cell's text.

Then we need to know if we're looking at a "new entry", or if we're continuing the previous one - isNewEntry is True if the first character of the currentCell is bold.

When isNewEntry is True, we increment the currentEntry counter (which is 0 until we first assign it with the first "new entry") so we know what row we're going to be writing to; the currentEntryText will then match the currentText, and the character-formatting offset will be at position 1.

When isNewEntry is False, we don't increment the currentEntry counter (we'll be appending to that cell's text instead), and we compute the new character-formatting offset by adding 1 to the length of the entire text for the current entry - then we update the currentEntryText to append the currentText - not because we need the text itself, but because we'll need it next iteration to compute the new character offset.

At this point we know what to write, and where to write it - only, if we work at the Range level, we're going to overwrite everything we did in the previous iteration, and lose the formatting... and we don't want that, so that's why we track these offsets...

We Insert the currentText at the end of the entryCell's current content, and then we begin iterating the characters in the currentCell, and literally copy the formatting - offsetting the characters by what we've tracked.

The above code preserves Bold, Italic, Underline, and Strikethrough formatting; changing it to also support Subscript and Superscript formats should be trivial.

Mathieu Guindon
  • 69,817
  • 8
  • 107
  • 235
  • When I tried to use your code, everything was ok till one bad moment. I catch an error 1004: method Insert of Characters class failed. I think it happend when we have more than 2 usual string to join ( I added screen, see **Activity Attributes** ) How it fix? – Anthony14 Jun 25 '19 at 23:10
  • But when I tried easy example ( can see on screen ), all works good – Anthony14 Jun 25 '19 at 23:16
  • Must be an off-by-one error (typical with offsetting code), not sure how that particular entry is different than the others or than the bogus test inputs I was giving it though. – Mathieu Guindon Jun 25 '19 at 23:20