Preserve Bold/Unbolded Text

[stuartgb100]

Hi,

I'm helping a friend with a mass of text data that has been imported into Excel.

The data is textual, consisting of bold text followed by unbolded, and forum help has shown me how to split bold from unbold.

However, it now seems there are issues with the imported data, namely
leading and trailing spaces chr 160, extra spaces.
I think I need to deal with these issues before splitting bold/unbold.

I think the sequence should be:
1. remove all chr 160 and replace with " " (a space)
2. remove all but one leading space
3. remove any trailing spaces
4. remove any additional spaces within the cell ( ie 3 becomes 2, then 2 becomes 1)

Now I thought I could do this but whatever I try leaves me with unbolded text.
So now I cannot splt bold and unbold.

The data is in a single column, and I can define the range.
So, for example:

Sub Remove160s()
With activesheet
.Range("B10:B40").Replace Chr(160), " ", xlPart
End With
End Sub

and bold text changes to unbolded.

Thanks.

 

[tonyyy]

stuartgb100,

You might consider the following...

Sub remove160s_1066933()
Dim r As Range
For Each r In Range("B10:B40")
    r.Characters(InStr(1, r.Value, Chr(160), 1), 1).Text = Chr(32)
Next
End Sub

If you have multiple 160s in a single cell, you may need to run the code multiple times; or create a loop through each character of each cell... but that might be slow.

Cheers,

tonyyy

 

[tonyyy]

A loop to address multiple 160s in a single cell...

Sub remove160s_loop_1066933()
Dim r As Range, found As Range
Do
    For Each r In Range("B10:B40")
        r.Characters(InStr(1, r.Value, Chr(160), 1), 1).Text = Chr(32)
    Next
    Set found = Range("B10:B40").Find(What:=Chr(160), After:=Cells(10, 2), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
Loop Until found Is Nothing
End Sub

 

[stuartgb100]

Thanks, however I lose the first character in each cell when running the loop code.

 

[tonyyy]

...I lose the first character in each cell when running the loop code.

I can't re-create your results. You can try a variation of the last line to...

Loop While Not found Is Nothing

...but I don't expect it'll change anything. Posting sample data might help uncover the cause. And if you changed anything in the code that would be helpful to know too.

 

[Peter_SSs]

2. remove all but one leading space

Wondering why leave a leading space?

 

[Peter_SSs]

Assuming ..
- You don't actually need that leading space mentioned above
- Any cell in the target range that has an entry has at least one leading bold character
- There will be (or can be) a space between the last bold non-space character and the first non-bold non-space character
- If there are multiple bold/non-bold section s in the cell (like the third example in your post here) then we can bold up to the last bold character in the cell.
.. then try

Sub CleanUpKeepBold()
  Dim i As Long, j As Long, lr As Long, chrs As Long, pos As Long
  Dim bBold As Boolean
  Dim s As String
  
  lr = Range("A" & Rows.Count).End(xlUp).Row
  For i = 2 To lr
    bBold = False
    With Cells(i, 1)
    chrs = Len(.Value)
      If chrs > 0 Then
        j = chrs + 1
        Do
          j = j - 1
          If .Characters(j, 1).Font.Bold = True Then bBold = True
        Loop Until bBold Or j < 2
        If bBold Then j = j + 1
        s = Application.Trim(Replace(Left(.Value, j - 1), Chr(160), " ")) & "|" & Application.Trim(Replace(Mid(.Value, j), Chr(160), " "))
        pos = InStr(1, s, "|")
        .Value = Replace(s, "|", " ")
        .Font.Bold = False
        .Characters(1, pos).Font.Bold = True
      End If
    End With
  Next i
End Sub

 

[stuartgb100]

Many thanks both.
I'll try them on more data.

Regards.

 

[Peter_SSs]

Forgot a couple of lines of code that I think you will benefit from with my code.

Sub CleanUpKeepBold()
  Dim i As Long, j As Long, lr As Long, chrs As Long, pos As Long
  Dim bBold As Boolean
  Dim s As String
  
  Application.ScreenUpdating = False
  lr = Range("A" & Rows.Count).End(xlUp).Row
  For i = 2 To lr
  .
  .
  .
  Next i
  Application.ScreenUpdating = True
End Sub