Makes bold a chosen word in a cell

[makiwara]

The sheet's name is: animals

A B

1. lion The lions are beatufil animals.
2. dog Dogland is the home of the animals.

I need a VBA code which examines the words in column "A" and notes the first 2 characters of the word and then if a word in column "B" starts with that 2 characters then the code makes the whole word bold in column B.

Thank you for your time and help, it means to me a lot, if you try to help me!

Have a very nice day! https://www.mrexcel.com/forum/images/smilies/icon_smile.gif

[SamT]

What should happen if
3. baby Babalouie is the king of baboons.

[Tom Jones]

What should happen if
3. baby Babalouie is the king of baboons.

or

dog do ... ... door

[MINCUS1308]

Lion
The lions are beatufil animals.


Dog
Dogland is the home of the animals.





Sub ThisIsDumb()
Set Rng = Columns(1)
For Each aCell In Rng.Cells
If aCell.Value = "" Then Exit Sub

MyString = UCase(Left(Cells(aCell.Row, 1).Value, 2))
MySentence = UCase(Cells(aCell.Row, 2).Value)

LocationStart = InStr(1, CStr(MySentence), CStr(MyString))

If LocationStart > 0 Then
i = LocationStart
Do Until Mid(MySentence, i, 1) = " "
i = i + 1
Loop

LocationEnd = i - LocationStart

With Cells(aCell.Row, 2).Characters(Start:=LocationStart, Length:=LocationEnd).Font
.FontStyle = "Bold"
End With

Else
Cells(aCell.Row, 3).Value = "String Not Found"
End If
Next aCell
End Sub

[MINCUS1308]

Lion

The lions are beatufil animals.



Dog

Dogland is the home of the animals.



Baby

Babalouie is the king of baboons.



Dog

do … … door






Sub ThisIsDumber()

Sub DumberYet()

StringCol = 1
SentenceCol = 2
StrLen = 2

Set Rng = Columns(StringCol)
For Each aCell In Rng.Cells
If aCell.Value = "" Then Exit Sub
StrCellValue = aCell.Value
MyStr = UCase(Left(StrCellValue, StrLen))
SenCellValue = Cells(aCell.Row, SentenceCol).Value
MySen = UCase(SenCellValue)

S_Loc = 1

Do While (InStr(S_Loc, MySen, MyStr) <> 0 And S_Loc <= Len(MySen))

I = InStr(S_Loc, MySen, MyStr)
MyStart = I
Do Until (Mid(MySen, I, 1) = " " Or I > Len(MySen) Or Mid(MySen, I, 1) = ".")
I = I + 1
Loop
W_Length = I - MyStart

Cells(aCell.Row, SentenceCol).Characters(Start:=MyStart, Length:=W_Length).Font.FontStyle = "Bold"

S_Loc = W_Length + S_Loc
Loop
Here:
Next aCell
end sub

[MINCUS1308]

Baby

BABAlouie is the king of BAboons.



dog

DO … … DOor



Lion

The LIons are beatufil animals.



Dog

DOgland is the home of the animals.





Sub DumberYet()
StrCol = 1
StrLen = 2
SentCol = 2

'LOOP THOUGH COLUMN 1 VALUES UNTIL BLANK
Set Rng = Columns(StrCol)
For Each aCell In Rng.Cells
If aCell.Value = "" Then Exit Sub
'UCASE ALL INSTANCES OF STRING IN SENTENCE
S_Loc = 1
Do
StrValue = Left(aCell.Value, StrLen)
SentValue = Cells(aCell.Row, SentCol).Value
I = InStr(S_Loc, UCase(SentValue), UCase(StrValue))
If I <> 0 Then
If I = 1 Then
Cells(aCell.Row, SentCol).Value = Left(UCase(SentValue), StrLen) & Right(SentValue, Len(SentValue) - I - 1)
Else
Cells(aCell.Row, SentCol).Value = Left(SentValue, I - 1) & Mid(UCase(SentValue), I, StrLen) & Right(SentValue, Len(SentValue) - I - 1)
End If
End If
S_Loc = I + StrLen
Loop Until I = 0
'BOLD ALL WORDS CONTAINING INSTANCES OF STRING
S_Loc = 1
Do
StrValue = Left(aCell.Value, StrLen)
SentValue = Cells(aCell.Row, SentCol).Value
I = InStr(S_Loc, UCase(SentValue), UCase(StrValue))
If I <> 0 Then
W_Start = I
Do Until (Mid(SentValue, I, 1) = " " Or Mid(SentValue, I, 1) = "." Or I >= Len(SentValue))
I = I + 1
Loop
W_Len = I - W_Start
Cells(aCell.Row, SentCol).Characters(Start:=W_Start, Length:=W_Len).Font.FontStyle = "Bold"
End If
S_Loc = I
Loop Until I = 0
Next aCell
End Sub

[MINCUS1308]

:anyone:

[J FelixBosco]

Hi makiwara,
Please try the below code.


Sub Bold_er()

Dim i As Long
Dim s As Variant
Dim pos As Long 'store position
Dim sarray() As String 'part of string
Dim position As Collection 'positions
Dim Length As Collection ' word lengths

i = 1
Set position = New Collection
Set Length = New Collection

While ActiveSheet.Cells(i, 1).Value <> ""

With ActiveSheet

sarray = Split(.Cells(i, 2).Value, " ")
pos = 1

For Each s In sarray
If LCase(CStr(s)) Like LCase(Left(.Cells(i, 1), 2)) & "*" Then
position.Add pos
Length.Add Len(s)
End If
pos = pos + Len(s) + 1
Next

While position.Count <> 0

With .Cells(i, 2).Characters(position(1), Length(1)).Font
.FontStyle = "Bold"
End With

position.Remove (1)
Length.Remove (1)

Wend

Erase sarray
i = i + 1

End With

Wend
End Sub

Output of above code:

21884

[p45cal]

seems to have been solved at https://www.mrexcel.com/forum/excel-questions/1046738-can-you-help-me-i-need-vba-code-makes-bold-chosen-word-cell.html
makiwara, you need to read http://www.excelguru.ca/content.php?184