Find same value and Changing a cell & tex color WITHOUT using Conditional Formatting

[Dsunil05]

12

	19	21	25	29	31	32	33	34	36	37	39	44	50	53	55	66	74	75	77
08	13	16	18	22	23	31	39	45	47	52	59	64	70	71	72	73	74	77	79
																			. . . . . . . . . . . . .
03	09	10	11	13	18	19	27	35	37	44	50	57	59	65	70	72	76	79	80
02	05	11	14	17	28	32	33	37	38	42	47	59	63	64	71	73	74	77	78
03	06	08	09	13	21	24	30	31	36	38	42	49	54	59	65	70	72	75	79

<tbody>
</tbody>

data range A1:T27
i want to find out same number And change their "cell color and text color" in data range A1:T26 of row no 27's 20 number in pink colour.
Without using Conditional Formatting
Because i copy it and use it to another data set in same worksheet e.g. range U1:AO27
In MS Excel 2007
Thanks

 

[Peter_SSs]

1. Can you confirm whether A1:T27 contains any formulas or not? If so, which cells?

2. Are the values like 08 text "08" or just the number 8 with custom formatting to show the leading zero?

 

[Dsunil05]

1. Can you confirm whether A1:T27 contains any formulas or not? If so, which cells?

2. Are the values like 08 text "08" or just the number 8 with custom formatting to show the leading zero?

1. No, there is not any formulas. I am doing it manually

2. the values like 08 Number "08"

 

[Peter_SSs]

2. the values like 08 Number "08"

That is not clear to me. In your image, cell A2 shows "08" If you go to a blank cell and put this formula, what does it return?
=ISNUMBER(A2)

 

[Dsunil05]

It returns "TRUE"

 

[Peter_SSs]

It returns "TRUE"

OK, try this macro on a copy of your workbook.

Sub MarkMatches()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim Clr As Long, i As Long, j As Long, rws As Long, cols As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  With Range("A1:T27")
    Clr = .Cells(.Rows.Count, 1).Font.Color
    a = .Value
    rws = UBound(a, 1)
    cols = UBound(a, 2)
    ReDim b(1 To rws - 1, 1 To cols)
    For j = 1 To cols
      d(a(rws, j)) = 1
    Next j
    For i = 1 To rws - 1
      For j = 1 To cols
        If d(a(i, j)) = 1 Then b(i, j) = 1
      Next j
    Next i
    .Font.Color = 0
    .Value = b
    .SpecialCells(xlConstants).Font.Color = Clr
    .Value = a
  End With
  Application.ScreenUpdating = True
End Sub

 

[Dsunil05]

not working
same no of range A27:T27 in Between rang A1:T26 number color not change
not finding duplicate

 

[Rick Rothstein]

OK, try this macro on a copy of your workbook.

Sub MarkMatches()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim Clr As Long, i As Long, j As Long, rws As Long, cols As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  With Range("A1:T27")
    Clr = .Cells(.Rows.Count, 1).Font.Color
    a = .Value
    rws = UBound(a, 1)
    cols = UBound(a, 2)
    ReDim b(1 To rws - 1, 1 To cols)
    For j = 1 To cols
      d(a(rws, j)) = 1
    Next j
    For i = 1 To rws - 1
      For j = 1 To cols
        If d(a(i, j)) = 1 Then b(i, j) = 1
      Next j
    Next i
    .Font.Color = 0
    .Value = b
    .SpecialCells(xlConstants).Font.Color = Clr
    .Value = a
  End With
  Application.ScreenUpdating = True
End Sub

If your interpretation of what the OP wanted is correct, then your macro can be written more compactly (it may even be faster) this way...

[table="width: 500"]
[tr]
	[td]Sub MarkMatches()
  Dim C As Long
  Application.ReplaceFormat.Clear
  For C = 1 To 20
    Application.ReplaceFormat.Font.Color = Cells(27, 1).Font.Color
    Range("A1:T26").Replace Cells(27, C), "", xlWhole, searchformat:=False, ReplaceFormat:=True
  Next
End Sub[/td]
[/tr]
[/table]

However, I read the OP's request differently. I took the text snippet "And change their 'cell color and text color'" from his original post to mean the each cell in A27:T27 has a different interior and font color (even though his posted table shows all the interiors/fonts the same) and that he wants those copied into the matching cells. Here is my code for that interpretation of the OP's request...

[table="width: 500"]
[tr]
	[td]Sub MatchNumbersCopyFormats()
  Dim C As Long
  Application.ReplaceFormat.Clear
  For C = 1 To 20
    Application.ReplaceFormat.Interior.Color = Cells(27, C).Interior.Color
    Application.ReplaceFormat.Font.Color = Cells(27, C).Font.Color
    Range("A1:T26").Replace Cells(27, C), "", xlWhole, SearchFormat:=False, ReplaceFormat:=True
  Next
End Sub[/td]
[/tr]
[/table]

 

[Rick Rothstein]

If your interpretation of what the OP wanted is correct, then your macro can be written more compactly (it may even be faster) this way...

[table="width: 500"]
[tr]
	[td]Sub MarkMatches()
  Dim C As Long
  Application.ReplaceFormat.Clear
  For C = 1 To 20
    Application.ReplaceFormat.Font.Color = Cells(27, 1).Font.Color
    Range("A1:T26").Replace Cells(27, C), "", xlWhole, searchformat:=False, ReplaceFormat:=True
  Next
  [B][COLOR="#FF0000"]Application.ReplaceFormat.Clear[/COLOR][/B]
End Sub[/td]
[/tr]
[/table]

However, I read the OP's request differently. I took the text snippet "And change their 'cell color and text color'" from his original post to mean the each cell in A27:T27 has a different interior and font color (even though his posted table shows all the interiors/fonts the same) and that he wants those copied into the matching cells. Here is my code for that interpretation of the OP's request...

[table="width: 500"]
[tr]
	[td]Sub MatchNumbersCopyFormats()
  Dim C As Long
  Application.ReplaceFormat.Clear
  For C = 1 To 20
    Application.ReplaceFormat.Interior.Color = Cells(27, C).Interior.Color
    Application.ReplaceFormat.Font.Color = Cells(27, C).Font.Color
    Range("A1:T26").Replace Cells(27, C), "", xlWhole, SearchFormat:=False, ReplaceFormat:=True
  Next
  [B][COLOR="#FF0000"]Application.ReplaceFormat.Clear[/COLOR][/B]
End Sub[/td]
[/tr]
[/table]

I forgot to include the "clean up" code line I show in red above. It is not critical to the operation of the code, rather, it is a kindness to the OP for the next time he uses Excel's Find dialog box. The VBA Replace function and Excel's Find/Replace dialog box share the same search and replace format criteria, so if we don't clean up our code as above, any search and/or replace format criteria we set in our code would be "remembered" by Excel the next time the Find/Replace dialog box is called and, hence, be in effect even if the OP did not realize it.

 

[Dsunil05]

I forgot to include the "clean up" code line I show in red above. It is not critical to the operation of the code, rather, it is a kindness to the OP for the next time he uses Excel's Find dialog box. The VBA Replace function and Excel's Find/Replace dialog box share the same search and replace format criteria, so if we don't clean up our code as above, any search and/or replace format criteria we set in our code would be "remembered" by Excel the next time the Find/Replace dialog box is called and, hence, be in effect even if the OP did not realize it.

still not working

how post the screen shot of my manual work