Bolding text in excel

[mohanyathish]

Hi,

I have to find a set of words in excel and bold them so that i will be able to look at the cells with those words only...

Lets say...

i need to find the occurrence of "water" and "fire".

i want the only words "water" and "fire" to be bolded in the cell and all the other words in their original format...i am using office 2003 and 2007....

could anybody pls help...?

 

[brettdj]

This code will find all occurences of water (as cell values) then will bold them. It will handle multiple occurrences in a string string

rerun with this line
Const strText As String = "water"
changed to
Const strText As String = "fire"

to cater for both strings

hth

Dave

Option Explicit
Const strText As String = "water"

Sub BoldMe()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim cel1 As Range
    Dim cel2 As Range
    Dim lngCel As Long
    Dim strFirstAddress As String
    Dim lAppCalc As Long

    'Get working range from user
    On Error Resume Next
    Set rng1 = Application.InputBox("Please select range to search for " & strText, "User range selection", Selection.Address(0, 0), , , , , 8)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub

    With Application
        lAppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    'a) match string to entire cell, case insensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , False)
    'b) match string to entire cell, case sensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , True)
    'c)match string to part of cell, case insensititive
    Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False)
    'd)match string to part of cell, case sensititive
    ' Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , True)

    'A range variable - rng2 - is used to store the range of cells that contain the string being searched for
    If Not cel1 Is Nothing Then
        Set rng2 = cel1
        strFirstAddress = cel1.Address
        Do
            Set cel1 = rng1.FindNext(cel1)
            Set rng2 = Union(rng2, cel1)
        Loop While strFirstAddress <> cel1.Address
    End If

    'Further processing of found range if required
    If Not rng2 Is Nothing Then
        For Each cel2 In rng2
        lngCel = 1
            Do While InStr(lngCel, cel2.Value, strText) <> 0
                lngCel = InStr(lngCel, cel2.Value, strText)
                cel2.Characters(lngCel, Len(strText)).Font.FontStyle = "Bold"
                lngCel = lngCel + Len(strText)
            Loop
        Next
    End If

    With Application
        .ScreenUpdating = True
        .Calculation = lAppCalc
    End With
End Sub

 

[mohanyathish]

Thanks for the quick response...this surely helps....but would it not be better if the user enters both the words at a time seperated by commas and the macro is run only once.....?
What i thought was other users had to bold more words they have to rerun the macro.....
Can this macro be modified to accept the words to be bolded from the user seperated by commas....and the bolding it......?

Thanks for the time and effort you put into this...

 

[brettdj]

Updated

Cheers

Dave

Option Explicit


Sub BoldMe()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim cel1 As Range
    Dim cel2 As Range
    Dim lngCel As Long
    Dim strFirstAddress As String
    Dim lAppCalc As Long
    Dim strArray()
    Dim strText
    

    'Get working range from user
    On Error Resume Next
    Set rng1 = Application.InputBox("Please select range to search", "User range selection", Selection.Address(0, 0), , , , , 8)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub

   strArray = Array("water", "fire")

    With Application
        lAppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    For Each strText In strArray

    'a) match string to entire cell, case insensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , False)
    'b) match string to entire cell, case sensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , True)
    'c)match string to part of cell, case insensititive
    Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False)
    'd)match string to part of cell, case sensititive
    ' Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , True)

    'A range variable - rng2 - is used to store the range of cells that contain the string being searched for
    If Not cel1 Is Nothing Then
        Set rng2 = cel1
        strFirstAddress = cel1.Address
        Do
            Set cel1 = rng1.FindNext(cel1)
            Set rng2 = Union(rng2, cel1)
        Loop While strFirstAddress <> cel1.Address
    End If

    'Further processing of found range if required
    If Not rng2 Is Nothing Then
        For Each cel2 In rng2
        lngCel = 1
            Do While InStr(lngCel, cel2.Value, strText) <> 0
                lngCel = InStr(lngCel, cel2.Value, strText)
                cel2.Characters(lngCel, Len(strText)).Font.FontStyle = "Bold"
                lngCel = lngCel + Len(strText)
            Loop
        Next
    End If
    Next

    With Application
        .ScreenUpdating = True
        .Calculation = lAppCalc
    End With
End Sub

 

[mohanyathish]

this works really great....!

But....cant we accept the data from the user...?
for example...

input box : "please enter the search terms to be bold"

data entered by user: water, fire

can the macro be modified to do that..?

thanks for you time and effort on this...

hoping for a reply soon...

 

[brettdj]

Option Explicit


Sub BoldMe()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim cel1 As Range
    Dim cel2 As Range
    Dim lngCel As Long
    Dim strFirstAddress As String
    Dim lAppCalc As Long
    Dim strArray
    Dim strText
    Dim strIn As String


    'Get working range from user
    On Error Resume Next
    Set rng1 = Application.InputBox("Please select range to search", "User range selection", Selection.Address(0, 0), , , , , 8)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub


    strIn = Application.InputBox("Enter words to bold, separated by , (no spaces)", , , , , , , 2)
    strArray = Split(strIn, ",")

    With Application
        lAppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    For Each strText In strArray

        'a) match string to entire cell, case insensitive
        'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , False)
        'b) match string to entire cell, case sensitive
        'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , True)
        'c)match string to part of cell, case insensititive
        Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False)
        'd)match string to part of cell, case sensititive
        ' Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , True)

        'A range variable - rng2 - is used to store the range of cells that contain the string being searched for
        If Not cel1 Is Nothing Then
            Set rng2 = cel1
            strFirstAddress = cel1.Address
            Do
                Set cel1 = rng1.FindNext(cel1)
                Set rng2 = Union(rng2, cel1)
            Loop While strFirstAddress <> cel1.Address
        End If

        'Further processing of found range if required
        If Not rng2 Is Nothing Then
            For Each cel2 In rng2
                lngCel = 1
                Do While InStr(lngCel, cel2.Value, strText) <> 0
                    lngCel = InStr(lngCel, cel2.Value, strText)
                    cel2.Characters(lngCel, Len(strText)).Font.FontStyle = "Bold"
                    lngCel = lngCel + Len(strText)
                Loop
            Next
        End If
    Next

    With Application
        .ScreenUpdating = True
        .Calculation = lAppCalc
    End With
End Sub

 

[mohanyathish]

thanks...

that was perfect.....perfect to the last letter.....

thanks for your effort and time....

 

[brettdj]

No probs, glad to helped

And thanks for the feedback, too often these threads finish with the expert solution as the last post.

Regards

Dave