need same color as per row 1

[sksanjeev786]

Hi,

Can i get the color based on the row 1 font color in Row 4

everytime row 4 order will change

book3
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1		Used the brand	Store shelf	Friends or family	Saw AOTC using it	Store ads / signs	Online tobacco retailer website	Social media post by AOTC	Store clerk	Brand's website	Web ad	Web search	Brand’s social media	Brand rewards program	Saw at an event	Text	Email	Coupon	Piece of mail	Customer service	Saw a TV ad at a gas station
2
3
4	Color based on Row 1	Used the brand	Store shelf	Store ads / signs	Saw AOTC using it	Friends or family	Social media post by AOTC	Store clerk	Brand's website	Online tobacco retailer website	Brand’s social media	Web search	Saw a TV ad at a gas station	Brand rewards program	Coupon	Web ad	Saw at an event	Email	Piece of mail	Text	Customer service
Sheet1

 

[Kaper]

I don't think it is possible with formulas only. You can use simple macro to do it.

Like:

Sub copy_color()
  Dim i As Long, lc As Long
  lc = WorksheetFunction.Max(Cells(1, Columns.Count).End(xlToLeft).Column, Cells(4, Columns.Count).End(xlToLeft).Column)
  For i = 2 To lc
    Cells(4, i).Font.Color = Cells(1, i).Font.Color
  Next i
End Sub

 

[sksanjeev786]

I don't think it is possible with formulas only. You can use simple macro to do it.

Like:

Sub copy_color()
  Dim i As Long, lc As Long
  lc = WorksheetFunction.Max(Cells(1, Columns.Count).End(xlToLeft).Column, Cells(4, Columns.Count).End(xlToLeft).Column)
  For i = 2 To lc
    Cells(4, i).Font.Color = Cells(1, i).Font.Color
  Next i
End Sub

Hi Sir,

thanks for checking but look like color are not matching for few stubs
I have bordered them Cell D1 and F4 and I1 and H4 for example

book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1		Used the brand	Store shelf	Friends or family	Saw AOTC using it	Store ads / signs	Online tobacco retailer website	Social media post by AOTC	Store clerk	Brand's website	Web ad	Web search	Brand’s social media	Brand rewards program	Saw at an event	Text	Email	Coupon	Piece of mail	Customer service	Saw a TV ad at a gas station
2
3
4	Color based on Row 1	Used the brand	Store shelf	Store ads / signs	Saw AOTC using it	Friends or family	Social media post by AOTC	Store clerk	Brand's website	Online tobacco retailer website	Brand’s social media	Web search	Saw a TV ad at a gas station	Brand rewards program	Coupon	Web ad	Saw at an event	Email	Piece of mail	Text	Customer service
Sheet2

 

[MARK858]

Looks like you need the Fonts Bolded as well

  For i = 2 To lc
    Cells(4, i).Font.Color = Cells(1, i).Font.Color
    Cells(4, i).Font.Bold = True
  Next i

 

[sksanjeev786]

Looks like you need the Fonts Bolded as well

  For i = 2 To lc
    Cells(4, i).Font.Color = Cells(1, i).Font.Color
    Cells(4, i).Font.Bold = True
  Next i

yes! but color are not matching as per row 1 attribute...

for example "Friends or family" row1 and row 4 "Friends or family" is differ so I need as per row 1

 

[MARK858]

They match for me if they are bolded (actually the colour matched anyway, they just needed bolding to appear the same)

 

[MARK858]

Or are you saying you need to search for the text and then change the colour to match?

 

[MARK858]

Or are you saying you need to search for the text and then change the colour to match?

If the above try...

Sub copy_color2()
    Dim i As Long, lc As Long, myRng As Range, fndCell As Range
    Application.ScreenUpdating = False
 
    lc = WorksheetFunction.Max(Cells(1, Columns.Count).End(xlToLeft).Column, Cells(4, Columns.Count).End(xlToLeft).Column)
    Set myRng = Range(Cells(1, 1), Cells(1, lc))
 
    For i = 2 To lc
        Set fndCell = myRng.Find(Cells(4, i), Cells(1, 1), xlValues, xlWhole, xlByColumns, xlNext)
   
        Cells(4, i).Font.Color = fndCell.Font.Color
        Cells(4, i).Font.Bold = True
    Next i

End Sub

 

[sksanjeev786]

If the above try...

Sub copy_color2()
    Dim i As Long, lc As Long, myRng As Range, fndCell As Range
    Application.ScreenUpdating = False
 
    lc = WorksheetFunction.Max(Cells(1, Columns.Count).End(xlToLeft).Column, Cells(4, Columns.Count).End(xlToLeft).Column)
    Set myRng = Range(Cells(1, 1), Cells(1, lc))
 
    For i = 2 To lc
        Set fndCell = myRng.Find(Cells(4, i), Cells(1, 1), xlValues, xlWhole, xlByColumns, xlNext)
  
        Cells(4, i).Font.Color = fndCell.Font.Color
        Cells(4, i).Font.Bold = True
    Next i

End Sub

Wow!! thank you so much for your support and help

 

[MARK858]

You're welcome, happy we could help