VBA to change font type based on cell text

[sabbuck]

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.

 

[sabbuck]

1. I have the correct range with the correct sheet name.
2. It's definitelyt in the correct place: in the ThisWorkbook module
I just have one command button on sheet1. No other codes on any other sheet.
4. And the code on sheet1 does not include the line "Application.EnableEvents = False".

However, I have made progress with another code: This time entering it for each sheet rather than on ThisWorkbook.

"Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("B6:B94, Y6:Y94")) Is Nothing Then Exit Sub
If Target.Value = "P" Or Target.Value = "O" Then
    With Target.Font
        .Name = "wingdings 2"
    End With
Else
    With Target.Font
        .Name = "Calibri"
    End With
End If
End Sub"

The font is now Calibri and changes to Wingdings 2 if "P" or "O". Meaning that when the command button is clicked to reset the questionnaire, "please select" is in Calibri.

But now my problem is this:

Some questions are repetitive so I have linked the answer to the very first time this question is asked, so that it automatically fills and the cell is locked so the user can't edit it (it will always be the same as the first answer). But because it's a formula in the cell (a vlookup) it is not being formatted to Wingdings 2.

I suppose I don't need a VBA for this, just change the formatting to wingdings 2 for these cells only, and set the conditional formatting to white text so that it appears empty until the corresponding question is answered and then it will be a tick or an X symbol.

Is theis the easiet way or have I made a mountain out of a molehill in your opinion?

 

[Fluff]

CF would probably be the easiest way

 

[Peter_SSs]

@Peter_SSs
If the OP has a button on Sheet1 that resets all the other sheets, ... yours will fail as it's trying to work on the activesheet.

Quite correct. I think this addition should fix that (but haven't had much time to test)

Set Changed = Intersect(Target, Sh.Range(RngAddr))