Changing font on certain letters

[Robert87]

Hey!

I need some help since I´m totally new to VBA.

I´m trying to get my excel wo change the font on all cells wich includes the letters: f,g,h,i,j,k,m and l in them. They have to be lower case to be changed.

Only cells in the range of D9:M510 should be changed, and they should be changed to Wingdings 3.

Can anyone help me with this?

Thanks!

/Robert

[mikerickson]

Do you want only those letters to be changed to Wingdings 3 or the whole cell?
If the cells contain formulas, rather than user input data, then it can't be done. The characters in Cells with formulas have to have the same format.

[Robert87]

There will be no formulas in thoose cells, so that´s not a problem.

If the cell has one of thoose letters in lower case in it, the whole cell can be changed.

[Kenneth Hobs]

I just did it for the characters in the array a(). Obviously, the whole cell would be easier but somewhat similar.


Option Explicit
Option Compare Binary

Sub WingDingsFtoM()
Dim c As Range, r As Range
Dim v As Variant, a() As String, i As Integer

Set r = Range("D9:DM510")
a() = Split("f g h i j k l m", " ")

For Each c In r
With c
If IsEmpty(c) Then GoTo NextC
For i = 1 To Len(.Value2)
For Each v In a()
If .Characters(i, Len(.Value2)).Font.Name <> "Wingdings 3" And _
Mid(.Value2, i, 1) = v Then _
.Characters(i, 1).Font.Name = "Wingdings 3"
Next v
Next i
NextC:
End With
Next c
End Sub

[mikerickson]

Do you want this to be dynamic (change to the appropriate font if the user changes the cells data) or is it a one time thing?
This is a one-shot loop.


Sub test()
Dim oneCell As Range
Dim keyLetters As String

keyLetters = "fghijkl"

For Each oneCell In Sheet1.Range("Q1:Q10")
If CStr(oneCell.Value) Like "*[" & keyLetters & "]*" Then
oneCell.Font.Name = "Wingdings 2"
Else
oneCell.Style = "Normal"
End If
Next oneCell
End Sub

[Robert87]

I just did it for the characters in the array a(). Obviously, the whole cell would be easier but somewhat similar.


Option Explicit
Option Compare Binary

Sub WingDingsFtoM()
Dim c As Range, r As Range
Dim v As Variant, a() As String, i As Integer

Set r = Range("D9:DM510")
a() = Split("f g h i j k l m", " ")

For Each c In r
With c
If IsEmpty(c) Then GoTo NextC
For i = 1 To Len(.Value2)
For Each v In a()
If .Characters(i, Len(.Value2)).Font.Name <> "Wingdings 3" And _
Mid(.Value2, i, 1) = v Then _
.Characters(i, 1).Font.Name = "Wingdings 3"
Next v
Next i
NextC:
End With
Next c
End Sub


I´m using this code and it works like a charm.

Thanks alot!

But the layout of the dokument has changed and I need to select a few specific cells to run the macro on, not a big range of cells.

But it´s too many cells so I can´t put all cells in a single line.

It´s theese cells:
F3,AA3,F15,AA15,F27,AA27,F39,AA39,F51,AA51,F63,AA63,F75,AA75,F87,AA87,F99,A A99,F111,AA111,F123,AA123,F135,AA135,F147,AA147,F159,AA159,F171,A171,F183,A A183,F195,AA195,F207,AA207,F219,AA219,F231,AA231,F243,AA243,F255,AA255,F267 ,AA267,F279,AA279,F291,AA291,F303,AA303,F315,AA315,F327,AA327,F339,AA339,F3 51,AA351,F363,AA363,F375,AA375,F387,AA387,F399,AA399,F411,AA411,F423,AA423, F435,AA435,F447,AA447,F459,AA459,F471,AA471,F483,AA483,F495,AA495,F507,AA50 7,F519,AA519,F531,AA531,F543,AA543,F555,AA555,F567,AA567,F579,AA579,F591,AA 591

[Aussiebear]

Try this….


Option Explicit
Option Compare Binary

Sub WingDingsFtoM()
Dim c As Range, r As Range
Dim v As Variant, a() As String, i As Integer
Set r = Range("F3, AA3, F15, AA15, F27, AA27, F39, AA39, F51, AA51, F63, AA63, F75, AA75, F87, AA87, F99, AA99, F111, AA111, F123, AA123, F135, AA135, F147, AA147, F159, AA159, F171, A171, _
F183, AA183, F195, AA195, F207, AA207, F219, AA219, F231, AA231, F243, AA243, F255, AA255, F267, AA267, F279, AA279, F291, AA291, F303, AA303, F315, AA315, F327, AA327, F339, AA339, F351, _
AA351, F363, AA363, F375, AA375, F387, AA387, F399, AA399, F411, AA411, F423, AA423, F435, AA435, F447, AA447, F459, AA459, F471, AA471, F483, AA483, F495, AA495, F507, AA507, F519, AA519, _
F531, AA531, F543, AA543, F555, AA555, F567, AA567, F579, AA579, F591, AA591")
a() = Split("f g h i j k l m", " ")
For Each c In r
With c
If IsEmpty c Then Goto Next C
For i = 1 To Len(.Value2)
For Each v In a()
If .Characters(i, Len(.Value2)).Font.Name <> "Wingdings 3" And _
Mid(.Value2, i, 1) = v Then _
.Characters(i, 1).Font.Name = "Wingdings 3"
Next v
Next i
Next C:
End With
Next c
End Sub

[Kenneth Hobs]

If this needs to be a changing set of cells to run it on, just "set r = selection" in my code or Mike's and select the cells you want to run it on and then run it.

If you are going to use r as Aussiebear demonstrated and you have even more cells, you can use Union() to join several ranges as needed. Keep in mind that you can set range areas as-well-as single cells, using Range as Aussiebear demonstrated.

e.g.

Set r = Range("A1:C1,D5")