Need help with Macro data color

[sksanjeev786]

Hi Team,

I have data in A to C column and I have pulled a few statements in columns E to G so now I need the same color that we have in Column B to C.

Book1
	A	B	C	D	E	F	G	H	I
1	Acknowledges Employees’ Cultural Traditions	60%	71%			2	3
2	Allows Relationships with Other Employees	65%	72%
3	Can Be My Authentic Self	61%	82%
4	Can Express My Passion & Creativity	57%	75%		Can Express My Passion & Creativity	57%	75%
5	Communicates Effectively	63%	82%		Communicates Effectively	63%	82%
6	Empowers Employees to Drive Change	56%	70%		Encourages Collaboration/Teamwork	63%	72%
7	Encourages Work/Life Balance	57%	83%		Encourages Employees To Ask Questions	64%	75%
8	Encourages Collaboration/Teamwork	63%	72%		Encourages Employees To Try New Things	57%	78%
9	Encourages Employees To Ask Questions	64%	75%		Clear Growth & Development Plans	59%	23%
10	Encourages Employees To Try New Things	57%	78%		Fair & Equitable Compensation Policies	61%	83%
11	Encourages Friendships with Coworkers	62%	63%		Strict Policies Against Discrimination	61%	79%
12	Feels Like a Connected Community	61%	71%		Fun Place To Work	61%	74%
13	Feels Like a Family	55%	61%
14	Can Work My Way if I Meet Goals/Expectations	65%	78%
15	Diverse & Inclusive Workplace	61%	74%
16	Flexible Work Environment/Can Work Remotely	59%	33%
17	Clear Growth & Development Plans	59%	23%
18	Fair & Equitable Compensation Policies	61%	83%
19	Strict Policies Against Discrimination	61%	79%
20	Fun Place To Work	61%	74%
21	Strong Fit With My Values	58%	72%
22	Environmentally Responsible	55%	70%
23	Highly Recommended by Current Employees	58%	76%
Sheet1

Cell Formulas
Range	Formula
F4:G12	F4	=INDEX($A:$C,MATCH($E4,$A:$A,0),F$1)

 

[bebo021999]

Option Explicit
Sub color()
Dim lr&, i&, cell As Range, f
lr = Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In Range("E4:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    Set f = Range("A1:A" & lr).Find(cell.Value)
        For i = 1 To 2
            With cell.Offset(0, i).Font
                .color = f.Offset(0, i).Font.color
                .Bold = f.Offset(0, i).Font.Bold
            End With
        Next
Next
End Sub

 

[sksanjeev786]

Option Explicit
Sub color()
Dim lr&, i&, cell As Range, f
lr = Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In Range("E4:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    Set f = Range("A1:A" & lr).Find(cell.Value)
        For i = 1 To 2
            With cell.Offset(0, i).Font
                .color = f.Offset(0, i).Font.color
                .Bold = f.Offset(0, i).Font.Bold
            End With
        Next
Next
End Sub

Awesome!!!

Works very well.

Just wanted to check can we have the same thing as I have data in Sheet1 and Formula in Sheet 2. ( pulled data by using indirect function)

Thanks in Advance

Regards,
Sanjeev

 

[bebo021999]

try again:

Option Explicit
Sub color()
Dim lr&, i&, cell As Range, f
Worksheets("Sheet2").Activate
lr = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In Range("E4:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    Set f = Worksheets("Sheet1").Range("A1:A" & lr).Find(cell.Value)
        For i = 1 To 2
            With cell.Offset(0, i).Font
                .color = f.Offset(0, i).Font.color
                .Bold = f.Offset(0, i).Font.Bold
            End With
        Next
Next
End Sub

 

[sksanjeev786]

try again:

Option Explicit
Sub color()
Dim lr&, i&, cell As Range, f
Worksheets("Sheet2").Activate
lr = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In Range("E4:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    Set f = Worksheets("Sheet1").Range("A1:A" & lr).Find(cell.Value)
        For i = 1 To 2
            With cell.Offset(0, i).Font
                .color = f.Offset(0, i).Font.color
                .Bold = f.Offset(0, i).Font.Bold
            End With
        Next
Next
End Sub

Fantabulous!!!

Thank you so much Sir your help on this....!!!

Regards,
Sanjeev