Make bold every words in column "B" starting with the first two letter of column "A"

[makiwara]

Hi!

I had a problem and Fluff and Mumps solved it both professionally. I am practising now, so I try to modify their codes, but there is something wrong.

I want to keep the part of their codes, which splits the cell's content after every space, but at the command part, what i highlighted with RED, I want to add a new command.

It would make every word BOLD in column "B", which starts with the Left(Word,2) in column "A"

I made a picture so it's easier to understand:

https://imgur.com/a/xo3ro5G

First topic:
https://www.mrexcel.com/forum/excel...-cell-make-decision-depending-its-length.html

Fluff's solution:

Code:
Sub trimWords()
Dim Wrd As Variant
Dim Cl As Range

Range("A:A").Replace Chr(10), " ", , , , , False, False
For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
For Each Wrd In Split(Cl, " ")

Cl.Offset(, 1).Value = Cl.Offset(, 1).Value & " " & IIf(Len(Wrd) <= 6, Left(Wrd, 1), Left(Wrd, 2))

Next Wrd
Next Cl
End Sub

Mumps solution:
Code:
Sub makiwara()
Application.ScreenUpdating = False
Dim LastRow As Long

LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
Dim vRng As Variant
Dim i As Long

For Each rng In Range("A1:A" & LastRow)
vRng = Split(rng, " ")
For i = LBound(vRng) To UBound(vRng)

If Len(vRng(i)) <= 6 Then
rng.Offset(0, 1) = Trim(rng.Offset(0, 1) & " " & Left(vRng(i), 1))
Else
rng.Offset(0, 1) = Trim(rng.Offset(0, 1) & " " & Left(vRng(i), 2))
End If

Next i
Next rng

Application.ScreenUpdating = True
End Sub


And the 2. part of the code which I want to add instead of the RED lines:

Sub MakeSomeWordsBold()
Dim R As Long, x As Long, TwoLetters As String, CellText As String

With Sheets("animals")
For R = 1 To .Cells(Rows.Count, "A").End(xlUp).Row

Do
TwoLetters = Left(.Cells(R, "A").Value, 2)
CellText = .Cells(R, "B").Value
x = InStr(x + 1, CellText, TwoLetters, vbTextCompare)
If x Then .Cells(R, "B").Characters(x, InStr(x, .Cells(R, "B").Value, " ") - x + 1).Font.Bold = True
Loop While x

Next

End With
End Sub


Can somebody help me, how to combine Fluff's or Mumps' solution with the "bold making" part?

I really appreciate your patience and help, I hope one day I will have the knowledge of you, to give back to the Forum Members! Have a nice day!

 

[Peter_SSs]

Can somebody help me, how to combine Fluff's or Mumps' solution with the "bold making" part?

I have not studied the other codes, but this is how I would bold the words shown in your image given the sample data in columns A & B.

Sub Bold_Words()
  Dim RX As Object, M As Object
  Dim c As Range
  Dim s As String
  Dim itm As Variant
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
    s = Replace(c.Offset(, -1).Value, " ", "|")
    RX.Pattern = "(^|\|)(\w\w)([^\|]*)"
    RX.Pattern = "\b(" & (Mid(RX.Replace(s, "|$2"), 2)) & ")([^ ]*)"
    Set M = RX.Execute(c.Value)
    For Each itm In M
      c.Characters(itm.firstindex + 1, itm.Length).Font.Bold = True
    Next itm
  Next c
End Sub

 

[Peter_SSs]

Any success?

 

[makiwara]

Dear Peter!

Sorry for the late reply, unfortunately I could test it just today.

Your code workes perfect!!! Thank you for your help! It's really a master code, I don't understand too much of it, since I am a beginner, but I'm going to study it! It will be a great lecture for me! Thanks again!!:D

Any success?

 

[makiwara]

There is just one minor problem. In 99% the code is perfect, but there a really few situation, when not.

I collected 3 example from my sample file. (I typed every word to see if there is a non breaking space or other issue, but it seems that the problem is nothing similar)

Do you know maybe the cause of it? I really appreciate your time and knowledge! Have a very nice day!

For example:

log in	to log in to your account
log out	to log out of your account
look after	to look after your parents

<tbody>
</tbody>

Any success?

 

[Peter_SSs]

I do not get the results you are showing in post #5 . My results with that data is:

to log into your account
to log out of your account
to look after your parents

My first thought is that perhaps the whole cell(s) are already formatted as bold before the code is run? If that is the problem, then adding this extra line of code where shown should fix it. If the problem persists, post back and we'll see if we can figure out anything else that could be causing that to happen.

For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
  c.Font.Bold = False
  s = Replace(c.Offset(, -1).Value, " ", "|")

BTW, about how many rows of data are you likely to have?

 

[makiwara]

Peter, thank you! It turned out that I had spaces at the end of the cell, so it caused the problem. It has been solved by using a trim function.

Thank you very much for your kindness and help! Have a very nice day!

I do not get the results you are showing in post #5 . My results with that data is:

to log into your account
to log out of your account
to look after your parents

My first thought is that perhaps the whole cell(s) are already formatted as bold before the code is run? If that is the problem, then adding this extra line of code where shown should fix it. If the problem persists, post back and we'll see if we can figure out anything else that could be causing that to happen.

For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
  c.Font.Bold = False
  s = Replace(c.Offset(, -1).Value, " ", "|")

BTW, about how many rows of data are you likely to have?

 

[Peter_SSs]

It turned out that I had spaces at the end of the cell, so it caused the problem. It has been solved by using a trim function.

Ah, that would do it - & a simple solution.

Thank you very much for your kindness and help! Have a very nice day!

You are very welcome.