VBA to change font type based on cell text

sabbuck

New Member
Joined
Aug 21, 2017
Messages
24
Hi,

I have a spreadsheet that contains a questionnaire. The answers are in the form of a data validation drop down list which is either "P" or "O". The font is set as Wingdings 2 so that the P is a tick symbol and the O is an X symbol.

There are 4 different sheets that have this drop down list.

Range Sheet 1 = B6:B94, Y6:Y94
Range Sheet 2 = B6:B208, O6:O208
Range Sheet 3 = B6:B106, O6:O106
Range Sheet 4 = B6:B13, E6:E13

I have a command button (for when I want to start all over) that clears data in some cells but in the range above changes the text in the cell to "Please Select". But this comes up as Wingdings 2 characters.

Is there a VBA where if the cells in the above ranges = "Please Select" the font will change to Calibri. But if the text is "P" or "O" it remains as Wingdings 2?

Thanks in advance for any help.
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Are there any other sheets in the workbook as well as these 4 that you refer to here?
 
Upvote 0
How about
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   Dim Rng As Range
   If Target.CountLarge > 1 Then Exit Sub
   Select Case LCase(Sh.Name)
      Case "sheet1"
         Set Rng = Sh.Range("B6:B94,Y6:Y94")
      Case "sheet2"
         Set Rng = Sh.Range("B6:B208,O6:O208")
   End Select
   If Rng Is Nothing Then Exit Sub
   If Intersect(Target, Rng) Is Nothing Then Exit Sub
   Target.Font.Name = IIf(Target.Value = "Please Select", "Calibri", "Wingdings 2")
End Sub
This needs to go in the ThisWorkbook module. And you'll need to add the case s for the other 2 sheets
 
Upvote 0
Are there any other sheets in the workbook as well as these 4 that you refer to here?
Never mind. This would be my approach that would allow for multiple cells being changed at once (eg by code, pasting or Ctrl+Enter)

This would also go in the ThisWorkbook module (but don't try with both my code and Fluffs in the same workbook at the same time. :) )

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim Changed As Range, c As Range
  Dim RngAddr As String

  Select Case Sh.Name
    Case "Sheet 1"
      RngAddr = "B6:B94, Y6:Y94"
    Case "Sheet 2"
      RngAddr = "BB6:B208, O6:O208"
    Case "Sheet 3"
      RngAddr = "B6:B106, O6:O106"
    Case "Sheet 4"
      RngAddr = "B6:B13, E6:E13"
    Case Else

  End Select
  If Len(RngAddr) > 0 Then
    Set Changed = Intersect(Target, Range(RngAddr))
    If Not Changed Is Nothing Then
      For Each c In Changed
        If Len(c.Value) > 1 Then
          c.Font.Name = "Calibri"
        Else
          c.Font.Name = "Wingdings 2"
        End If
      Next c
    End If
  End If
End Sub
 
Last edited:
Upvote 0
Thanks both, but neither seem to be working for me.

I've tried both, and no errors appear but the font is still Wingdings after I click the command button. There are 9 sheets all together, but I only need the formatting on 4. They are Sheet2, Sheet3, Sheet4, and Sheet 11, named "Products & Services Controls", "Distribution Controls", "Geographical Controls", and "Membership Controls" respectively.

Do I need to change the sheet name to the correct sheet number, or the actual name, in the code?
 
Upvote 0
You need to change the code to your actual sheet names.
Also both the codes will run automatically, there is no need for a command button.
 
Upvote 0
I was just referring to the command button as I had filled in a few of the cells with the tick or X to see if they were still Wingdings 2 and then when I clicked the command button they would then say "please select" which I was hoping to be in Calibri, but unfortunately not yet.

I have now changed the sheet names to "Membership Controls" etc. but still no luck. And I tried both in cap lock and regular, as this has happened me before where a code didn't work because my sheet names weren't in caps, but no luck doing it that way either.
 
Upvote 0
Does each sheet have it's own command button, or do you have one button on another sheet?
 
Upvote 0
1. Confirming in relation to my code that you need to change the sheet names in my code to "Products & Services Controls", "Distribution Controls", "Geographical Controls", and "Membership Controls" though I note you have said you have done that. You also have to make sure you have matched up the correct name with the correct ranges to check.

2. Are you certain that you have the code in the correct place? In the ThisWorkbook module in the vba window, not one of the worksheet modules and not a standard module.

3. My understanding is that you will still have one or more command buttons as you are using them to reset some or all of the data validation cells to an initialised state. When your code makes those changes, that should automatically trigger the code that I (or Fluff) has provided. As far as my code is concerned, it doesn't matter whether you have 1 command button or 20 of them making changes.

4. In any of your code(s) that are operating in the workbook, do you have any "Application.EnableEvents = False" lines. It is possible that events have been disabled and, if so, our codes will not be triggered. Closing Excel completely and restarting would reset events to being enabled.
 
Upvote 0
@Peter_SSs
If the OP has a button on Sheet1 that resets all the other sheets, my code won't run & and yours will fail as it's trying to work on the activesheet.
 
Upvote 0

Forum statistics

Threads
1,215,110
Messages
6,123,146
Members
449,098
Latest member
Doanvanhieu

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