copy only bold text

[Karnitg]

Hey.
It's a bit compicated, so you can answer just part 1...
I have a lot of text in my excel, and some of the text in the cell might be bold.
part 1:
I would like to copy only the bold text from (E1:E500) to (F1:F500) in the cell next to the original.
each bold can be 1 word or a few
part 2:
in a cell there might be a few bold "groups"
I would want the first group to be in the cell next to the original, and each of the next groups on the next cells.
if a cell is already full, go the next one available.

 

[onlyadrafter]

Hello,

Have created a cumbersome macro for part 1, sure there is a more efficient method

Sub COPY_BOLD()
    Application.ScreenUpdating = False
    For MY_ROWS = 1 To Range("E" & Rows.Count).End(xlUp).Row
        For MY_COUNT = 1 To Len(Range("E" & MY_ROWS).Value)
            With Range("E" & MY_ROWS).Characters(Start:=MY_COUNT, Length:=1).Font
                    If .FontStyle = "Bold" Then
                        MY_WORD = MY_WORD & Mid(Range("E" & MY_ROWS), MY_COUNT, Length:=1)
                        MY_FOUND = "Y"
                        If MY_COUNT = Len(Range("E" & MY_ROWS).Value) Then
                            Range("F" & MY_ROWS).Value = MY_WORD
                            MY_WORD = ""
                            MY_FOUND = ""
                        End If
                    Else
                        If .FontStyle <> "Bold" And MY_FOUND = "Y" Then
                            Range("F" & MY_ROWS).Value = MY_WORD
                            MY_FOUND = ""
                            MY_WORD = ""
                            GoTo FOUND_1
                        End If
                    End If
                End With
        Next MY_COUNT
FOUND_1:
    Next MY_ROWS
    Application.ScreenUpdating = True
End Sub

 

[Karnitg]

Hello,

Have created a cumbersome macro for part 1, sure there is a more efficient method

Sub COPY_BOLD()
    Application.ScreenUpdating = False
    For MY_ROWS = 1 To Range("E" & Rows.Count).End(xlUp).Row
        For MY_COUNT = 1 To Len(Range("E" & MY_ROWS).Value)
            With Range("E" & MY_ROWS).Characters(Start:=MY_COUNT, Length:=1).Font
                    If .FontStyle = "Bold" Then
                        MY_WORD = MY_WORD & Mid(Range("E" & MY_ROWS), MY_COUNT, Length:=1)
                        MY_FOUND = "Y"
                        If MY_COUNT = Len(Range("E" & MY_ROWS).Value) Then
                            Range("F" & MY_ROWS).Value = MY_WORD
                            MY_WORD = ""
                            MY_FOUND = ""
                        End If
                    Else
                        If .FontStyle <> "Bold" And MY_FOUND = "Y" Then
                            Range("F" & MY_ROWS).Value = MY_WORD
                            MY_FOUND = ""
                            MY_WORD = ""
                            GoTo FOUND_1
                        End If
                    End If
                End With
        Next MY_COUNT
FOUND_1:
    Next MY_ROWS
    Application.ScreenUpdating = True
End Sub

hey. first of all thank you so much for the effort. unfortunately it didn't work. not sure why.

 

[yky]

It does work to pick the first bold word but it doesn't do anything and doesn't keep looking but go to the next row.

Try this modification. It'll show the bold word in a message box.

Sub COPY_BOLD()
Dim MY_ROWS As Integer
Dim MY_COUNT As Integer
Dim MY_WORD As String
Dim MY_FOUND As String


    Application.ScreenUpdating = False
    For MY_ROWS = 1 To Range("E" & Rows.Count).End(xlUp).Row
        For MY_COUNT = 1 To Len(Range("E" & MY_ROWS).Value)
            With Range("E" & MY_ROWS).Characters(Start:=MY_COUNT, Length:=1).Font
                    If .FontStyle = "Bold" Then
                        MY_WORD = MY_WORD & Mid(Range("E" & MY_ROWS), MY_COUNT, Length:=1)
                        MY_FOUND = "Y"
                        If MY_COUNT = Len(Range("E" & MY_ROWS).Value) Then
                            Range("F" & MY_ROWS).Value = MY_WORD
                            MY_WORD = ""
                            MY_FOUND = ""
                        End If
                    Else
                        If .FontStyle <> "Bold" And MY_FOUND = "Y" Then
                        MsgBox MY_WORD
                            Range("F" & MY_ROWS).Value = MY_WORD
                            MY_FOUND = ""
                            MY_WORD = ""
'                            GoTo FOUND_1
                        End If
                    End If
                End With
        Next MY_COUNT
'FOUND_1:
    Next MY_ROWS
    Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

Here is another macro that you can try...

Sub CopyBoldInColumnEtoColumnF()
  Dim X As Long, Txt As String, Rng As Range, V As Variant
  Application.ScreenUpdating = False
  For Each Rng In Range("E1", Cells(Rows.Count, "E").End(xlUp))
    Txt = Rng.Value
    For X = 1 To Len(Rng)
      If Not Rng.Characters(X, 1).Font.Bold Then Mid(Txt, X) = " "
    Next
    For Each V In Split(Trim(Txt), Space(2))
      If Len(Replace(V, " ", "")) Then Cells(Rows.Count, "F").End(xlUp).Offset(1) = Trim(V)
    Next
  Next
  Application.ScreenUpdating = True
End Sub

Note: Existing data is assumed to start in cell E1, output starts at cell F2

 

[Karnitg]

Here is another macro that you can try...

Sub CopyBoldInColumnEtoColumnF()
  Dim X As Long, Txt As String, Rng As Range, V As Variant
  Application.ScreenUpdating = False
  For Each Rng In Range("E1", Cells(Rows.Count, "E").End(xlUp))
    Txt = Rng.Value
    For X = 1 To Len(Rng)
      If Not Rng.Characters(X, 1).Font.Bold Then Mid(Txt, X) = " "
    Next
    For Each V In Split(Trim(Txt), Space(2))
      If Len(Replace(V, " ", "")) Then Cells(Rows.Count, "F").End(xlUp).Offset(1) = Trim(V)
    Next
  Next
  Application.ScreenUpdating = True
End Sub

Note: Existing data is assumed to start in cell E1, output starts at cell F2

that seems to work! many thank
But I couldn't make it leave the text in the next cell. it all went up...
if the bold text in E45 i want it to be copied to F45 (and if it has 2 than F45,F46..)
is that possible?

 

[Rick Rothstein]

if the bold text in E45 i want it to be copied to F45 (and if it has 2 than F45,F46..)
is that possible?

It depends... what should happen if there are two (or more) bold words in cell E45 and two or more bold works in cell E46?