Macro to Format Text String with Bold or Color

[Frank Bacchus]

Hi:

Can any one indicate for me the macro or code I would use to "bold" or "color (red)" in any column where the cells are text. Here is an example:

Column A has in A1:
(1) Distributed Systems to provide the USCM Migration Program and Enterprise GTI teams with a forecast of Citrix and Active Directory work - Completed - 03/25/2016
(2) Active Directory AD team to assign supplemental resource(s) to work with Distributed Systems to expedite requests and manage escalations - On Going
Pinn, Mark - Contributor - 05/13/2016
Column B has in B1:

(1) Conduct hardware-centric conversation with Thor, App dev team - All Hardware requirements has been achieved.
(2) Schedule meetings with app dev and app support to solidify process and needs.

I would like to
In A1
(1) Distributed Systems to provide the USCM Migration Program and Enterprise GTI teams with a forecast of Citrix and Active Directory work - Completed - 03/25/2016
(2) Active Directory AD team to assign supplemental resource(s) to work with Distributed Systems to expedite requests and manage escalations - On Going
Pinn, Mark - Contributor - 05/13/2016

In B1
(1) Conduct hardware-centric conversation with Thor, App dev team - All Hardware requirements has been achieved.
(2) Schedule meetings with app dev and app support to solidify process and needs.
I know which words I want to bold and which word I want to change the color. Ideally, if I can perform the formatting function with two seperate list of words (one for bolding and one for coloring) as input to the macro, that would be fantastic. List that the list is dynamic and I can add or delete words and any time.

Thanks to all you geniuses.

frank


Post moved to right section

 

[Luke M]

You'll need to expand on this idea for each type of formatting change you want to make, but hopefully this gives you a good starting point.

Sub MainSub()
    Application.ScreenUpdating = False
    Call FindBold(Range("C10:G20"), Range("K13:K14"))
    Application.ScreenUpdating = True
End Sub

Sub FindBold(rngSearch As Range, rngList As Range)
    Dim fCell As Range
    Dim c As Range
    Dim strFind As String
    Dim firstAdd As String
    Dim lngStart As Long
   
    'Loop over list of cells with keywords
    For Each c In rngList.Cells
        strFind = c.Value
        If strFind <> "" Then
       
            'We'll use the Find method to look for cells that have our criteria
            firstAdd = ""
            Set fCell = rngSearch.Find(what:=strFind, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
           
            If Not fCell Is Nothing Then
                firstAdd = fCell.Address
               
                Do
                    'When found, bold that portion of text
                    lngStart = InStr(1, fCell.Value, strFind)
                   
                    'IMPORTANT: this is the line of code that makes a change
                    'Could modify this to be colors instead using second line
                    fCell.Characters(lngStart, Len(strFind)).Font.Bold = True
                    fCell.Characters(lngStart, Len(strFind)).Font.Color = vbRed
                   
                    Set fCell = rngSearch.FindNext(fCell)
                Loop While fCell.Address <> firstAdd
            End If
        End If
    Next c

End Sub

 

[Hui]

Column A

Sub Format_Text()

Dim lr As Integer
Dim D1 As Integer, D2 As Integer
Dim c As Range

lr = Range("A" & Rows.Count).End(xlUp).Row
For Each c In Range("A1:A" & lr)
  D1 = InStr(1, c, "-")
  D2 = InStr(InStr(1, c, "-") + 1, c, "-")

  'Format Name
  With c.Characters(Start:=D1 + 2, Length:=D2 - D1).Font
  .Name = "Calibri"
  .FontStyle = "Bold"
  .Size = 11
  .ThemeColor = xlThemeColorLight1
  .TintAndShade = 0
  .ThemeFont = xlThemeFontMinor
  End With

  'Format Date
  With c.Characters(Start:=D2 + 2, Length:=Len(c) - D2).Font
  .Name = "Calibri"
  .FontStyle = "Regular"
  .Size = 11
  .Color = -16776961
  .TintAndShade = 0
  .ThemeFont = xlThemeFontMinor
  End With

Next c

End Sub

 

[Deepak]

Something like this...

Function chnage_the_layouts(Datarng As Range, dlist As Range)
Dim r As Range, r1 As Range, p As Integer, var As Variant


For Each r In Datarng
    For Each r1 In dlist
        p = InStr(1, r, r1.Value)
        If p > 0 Then
            r.Characters(p, Len(r1)).Font.Bold = r1.Offset(, 1)
            r.Characters(p, Len(r1)).Font.Color = r1.Offset(, 2)
        End If
    Next r1
   
    var = Split(r.Value, " ")
    For p = LBound(var) To UBound(var)
        If IsDate(Split(var(p), "(")(0)) Then r.Characters(InStr(1, r, var(p)), 10).Font.ColorIndex = 3
    Next p
   
Next r

End Function


Sub test()

    chnage_the_layouts [A1].CurrentRegion, [F5:F8]

End Sub