Find Text in cell and bold that line

[brainzlp]

Hello everyone,

I have a cell with several lines, i would like to search for "1º", and when find bold that whole line.
I found a macro that finds a text and bold it: (But has a lot of uncessary stuff i don't need like input box and stuff., only need to find 1º and bold line )

Sub FindAndBold()'Updateby Extendoffice 20160711
    Dim xFind As String
    Dim xCell As Range
    Dim xTxtRg As Range
    Dim xCount As Long
    Dim xLen As Integer
    Dim xStart As Integer
    Dim xRg As Range
    Dim xTxt As String
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("Please select data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    On Error Resume Next
    Set xTxtRg = Application.Intersect(xRg.SpecialCells(xlCellTypeConstants, xlTextValues), xRg)
    If xTxtRg Is Nothing Then
        MsgBox "There are no cells with text"
        Exit Sub
    End If
    xFind = Trim(Application.InputBox("What do you want to BOLD?", "Kutools for Excel", , , , , , 2))
    If xFind = "" Then
        MsgBox "No text was listed", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    xLen = Len(xFind)
    For Each xCell In xTxtRg
        xStart = InStr(xCell.Value, xFind)
        Do While xStart > 0
            xCell.Characters(xStart, xLen).font.Bold = True
            xCount = xCount + 1
            xStart = InStr(xStart + xLen, xCell.Value, xFind)
        Loop
    Next
    If xCount > 0 Then
        MsgBox "number of " & CStr(xCount) & " text be bolded!", vbInformation, "Kutools for Excel"
    Else
        MsgBox "Not find the specific text!", vbInformation, "Kutools for Excel"
    End If
End Sub

My Cell A1 is like this:
3º ABC
2º ABB
1º ACCC
5º ASDASD
5º ASDAS
6º ASDA

Essential what i need to when i find 1º bold that line.

Thanks for all your help

 

[Ron Coderre]

I recommend having your data in an Excel Table.
I used this data in a table named Table1:

Description
3º ABC
2º ABB
1º ACCC
5º ASDASD
5º ASDAS
6º ASDA

Then I created this macro to find "1º" in that list and make the cells bold

Sub BoldTargetCells()
Dim oLB As ListObject
Set oLB = ActiveSheet.ListObjects("Table1")
With oLB
    .Range.AutoFilter Field:=1, Criteria1:="=*1º*"
    .DataBodyRange.SpecialCells(Type:=xlCellTypeVisible).Font.Bold = True
    .AutoFilter.ShowAllData
End With
End Sub

Is that something you can work with?

 

[brainzlp]

I recommend having your data in an Excel Table.
I used this data in a table named Table1:

Description
3º ABC
2º ABB
1º ACCC
5º ASDASD
5º ASDAS
6º ASDA

Then I created this macro to find "1º" in that list and make the cells bold

I have a macro that puts the textbox + checkbox + caption values into a variable. Than paste that variable into a Cell. I can't have a table or several rows...

1 Cell, several lines. (This is what i have and i don't know a way to change this, otherwise i will get dificult on other macros)

 

[brainzlp]

anyone can help out with this?

 

[Fluff]

Cross posted https://www.excelforum.com/excel-pr...t-in-cell-and-bold-that-line.html#post4935886

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[Fluff]

How about

   Dim strt As Long, lst As Long
   strt = InStr(Range("B7").Value, "1º")
   lst = InStr(strt, Range("B7").Value, Chr(10))
   Range("B7").Characters(strt, lst - strt).Font.Bold = True

 

[brainzlp]

How about

   Dim strt As Long, lst As Long
   strt = InStr(Range("B7").Value, "1º")
   lst = InStr(strt, Range("B7").Value, Chr(10))
   Range("B7").Characters(strt, lst - strt).Font.Bold = True

Your code works for the first "1º" found

I have this thread also in:
https://www.excelforum.com/excel-pr...t-in-cell-and-bold-that-line.html#post4936192


I need all lines where 1º is found to be bolded, not only the first, is there a way?


Thank you very much for your help

 

[brainzlp]

problem solved.

Solution at: https://www.excelforum.com/excel-pr...968-find-text-in-cell-and-bold-that-line.html

[COLOR=#333333]Sub FindAndBold()[/COLOR]<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">    Dim xFind As String
    Dim xLen As Integer
    Dim xStart As Integer
    Dim StartPos As Variant
    Dim strA As String
    Dim a As Variant
    strA = Range("A1").Value
    xFind = "1º"
    For Each a In Split(strA, ChrW(10))
    If InStr(a, xFind) > 0 Then
        StartPos = InStr(strA, a)
        xLen = Len(a)
        Range("a1").Characters(StartPos, xLen).Font.Bold = True
    End If
    Next a
     </code>[COLOR=#333333]End Sub[/COLOR]

Thanks for everything

 

[Peter_SSs]

Here is another way to try if you are interested. I made the assumption that a line like "21º ACCC" would not get bolded even though it contains the text you are looking for. If such data is possible, my code would not bold it whereas the other code will.
If you did want a line like that bold, change the Pattern line in my code to

RX.Pattern = "^.*1º.*$"

This code will process all data cells in column A

Sub Bold_1deg()
  Dim RX As Object
  Dim itm As Variant
  Dim c As Range, rng As Range
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.MultiLine = True
  RX.Pattern = "^1º.*$"
  For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
    For Each itm In RX.Execute(c.Value)
      c.Characters(Start:=itm.firstindex + 1, Length:=itm.Length).Font.Bold = True
    Next itm
  Next c
  Application.ScreenUpdating = True
End Sub

 

[brainzlp]

Here is another way to try if you are interested. I made the assumption that a line like "21º ACCC" would not get bolded even though it contains the text you are looking for. If such data is possible, my code would not bold it whereas the other code will.
If you did want a line like that bold, change the Pattern line in my code to

RX.Pattern = "^.*1º.*$"


This code will process all data cells in column A

Sub Bold_1deg()
  Dim RX As Object
  Dim itm As Variant
  Dim c As Range, rng As Range
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.MultiLine = True
  RX.Pattern = "^1º.*$"
  For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
    For Each itm In RX.Execute(c.Value)
      c.Characters(Start:=itm.firstindex + 1, Length:=itm.Length).Font.Bold = True
    Next itm
  Next c
  Application.ScreenUpdating = True
End Sub

That's exactly what i wanted, although i can't put this on column A, i need a specific cell cuz it will be variable. Right now i have in "V91"