VBA need arrow

[sksanjeev786]

Hi Team,

I need arrow instead of p,q r font (Wingding)
can you please see the attaced file.

Book1
	E	F	G	H	I	J	K	L	M	N	O
5											p
6											r
7											q
8
9	Brand Favorability	66%	5.8 p	66%	-0.6 q	0%	0.0
10	Consideration Intent	66%	3.7	66%	-4.1	0%	0.0
11	Consideration First Choice	13%	-3.2	16%	-2.3	0%	0.0
12	Purchase Intent	63%	4.4	51%	3.3	0%	0.0
13	BA: Is a brand for me	61%	5.6 r	49%	0.8	0%	0.0
14	Additional Brand Metrics
Sheet1

 

[sksanjeev786]

I have explained this at least twice already and posted pictures that seem to show what you want. If the pics I posted don't show you want you want then you have to explain why.

I select/highlight "p" character...

View attachment 77027
I choose Wingdings3 and green ...
View attachment 77029

result:
View attachment 77030

If that's not what you want then you need to explain why. If it is what you want then you need to do the same.

Hi Micron,

Sorry for the inconvenience but i was looking for the macro as i have lot of data with same scenario if i do manually diffenately it will take lot of time

can you please help me wtih macro

Regards
Sanjeev

 

[Micron]

i was looking for the macro

You should have said so at the beginning. I'll see what I can do based on what you've posted, which is columns G and I and code behind the sheet.

 

[sksanjeev786]

You should have said so at the beginning. I'll see what I can do based on what you've posted, which is columns G and I and code behind the sheet.

Sure Micron,

Thank you so much for you help on this

 

[Micron]

try this in your sheet module

Sub WingdingFont()

SetWingdingFont Range("G1:G" & Range("G" & Rows.count).End(xlUp).Row)
SetWingdingFont Range("I1:I" & Range("I" & Rows.count).End(xlUp).Row)

End Sub

Sub SetWingdingFont(rng As Range)
Dim c As Range

For Each c In rng
     Select Case Right(c.Value, 1)
          Case "p"
               With c.Characters(InStrRev(c.Value, "p", -1), 1).Font
                    .Name = "Wingdings 3"
                    .Color = vbGreen 'RGB(0, 255, 0)
                    .Bold = True
               End With
          Case "r"
               With c.Characters(InStrRev(c.Value, "r", -1), 1).Font
                    .Name = "Wingdings 3"
                    .Color = vbGreen 'RGB(0, 255, 0)
                    .Bold = False
               End With
          
          Case "q"
               With c.Characters(InStrRev(c.Value, "q", -1), 1).Font
                    .Name = "Wingdings 3"
                    .Color = vbRed  'RGB(255, 0, 0)
                    .Bold = True
               End With
     End Select
Next

Set c = Nothing

End Sub

 

[sksanjeev786]

try this in your sheet module

Sub WingdingFont()

SetWingdingFont Range("G1:G" & Range("G" & Rows.count).End(xlUp).Row)
SetWingdingFont Range("I1:I" & Range("I" & Rows.count).End(xlUp).Row)

End Sub

Sub SetWingdingFont(rng As Range)
Dim c As Range

For Each c In rng
     Select Case Right(c.Value, 1)
          Case "p"
               With c.Characters(InStrRev(c.Value, "p", -1), 1).Font
                    .Name = "Wingdings 3"
                    .Color = vbGreen 'RGB(0, 255, 0)
                    .Bold = True
               End With
          Case "r"
               With c.Characters(InStrRev(c.Value, "r", -1), 1).Font
                    .Name = "Wingdings 3"
                    .Color = vbGreen 'RGB(0, 255, 0)
                    .Bold = False
               End With
         
          Case "q"
               With c.Characters(InStrRev(c.Value, "q", -1), 1).Font
                    .Name = "Wingdings 3"
                    .Color = vbRed  'RGB(255, 0, 0)
                    .Bold = True
               End With
     End Select
Next

Set c = Nothing

End Sub

Amazing..!!! Micron.

it works perfectly thank you so muchhhh for your help on this

 

[Micron]

Glad to see it works. Maybe mark this one as solved if you have a solution?

 

[sksanjeev786]

Glad to see it works. Maybe mark this one as solved if you have a solution?

Sure thank you so much Micron.