Search For and Change Font For Certain Words With VBA

4653

New Member
Joined
Apr 20, 2012
Messages
27
Office Version
  1. 365
Platform
  1. Windows
I'm trying to find a VBA code that will search a particular range, for example A1:D300 on Sheet 1, for the phrase "Discounts Applied" and will increase the font to 16 and bold it. That particular phrase will be the only phrase in the cell it is located in. If it doesn't find that exact phrase then it does nothing. Basically what I have is a spreadsheet with a Print button and that phrase is a moving target from one day to the next so I was going to incorporate a code that will search for that phrase and put it in bold and 16 font in the same Print vba code so it does it just before it prints.
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Try
VBA Code:
Sub MM1()
Dim c As Range
For Each c In Range("A1:D300")
    If c.Value = "Discounts Applied" Then
        With c.Font
            .Bold = True
            .Size = 16
        End With
    End If
Next c
End Sub
 
Upvote 0
This might be a little quicker
VBA Code:
Sub MM1()
Dim rng As Range, rngLast As Range, rngFound As Range, strFirstAddress As String
Set rng = ActiveSheet.Range("A1:D300")
Set rngLast = rng.Cells(rng.Cells.Count)
Set rngFound = rng.Find(What:="Discounts Applied", After:=rngLast, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
Set rngFound = rng.FindNext(rngFound)
 With rngFound.Font
    .Size = 16
    .Bold = True
    End With
Loop Until rngFound.Address = strFirstAddress
End If
End Sub
 
Upvote 0
Another option
VBA Code:
Sub a4653()

   With Application.ReplaceFormat
      .Clear
      .Font.Size = 16
      .Font.Bold = True
   End With
   Range("A1:D300").Replace "Discounts Applied", "Discounts Applied", xlWhole, , False, , False, True
   Application.ReplaceFormat.Clear
End Sub
 
Upvote 0
Try
VBA Code:
Sub MM1()
Dim c As Range
For Each c In Range("A1:D300")
    If c.Value = "Discounts Applied" Then
        With c.Font
            .Bold = True
            .Size = 16
        End With
    End If
Next c
End Sub
This worked perfect. Thanks so much. I haven't had a chance to try the other one out yet but I'll try it later this week and let you know if it accomplished what I was looking for also. Thanks again.
 
Upvote 0
Another option
VBA Code:
Sub a4653()

   With Application.ReplaceFormat
      .Clear
      .Font.Size = 16
      .Font.Bold = True
   End With
   Range("A1:D300").Replace "Discounts Applied", "Discounts Applied", xlWhole, , False, , False, True
   Application.ReplaceFormat.Clear
End Sub
Thanks for the solution. However, it didn't work for me because my "Discounts Applied" was being pulled in by a formula. I tried your code and it only worked for me if the "Discounts Applied" was actually typed in a cell rather than being pulled in with a formula.
 
Upvote 0

Forum statistics

Threads
1,223,238
Messages
6,170,939
Members
452,368
Latest member
jayp2104

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top