Finding matches coloring them and the color of the sheets

[k0st4din]

Hello
I would like to ask you if there is a way to help me with a macro that does the following:
1 sheet - not handled
sheet 2 - this is the database (most important column "G") - in it I have numbers that are likely to be repeated in sheets 3,4,5,6 etc in the same column "G" of the each sheet.
Assuming that each of the sheets in a certain color - this macro to search for matches and if it finds such a second sheet to color number in the color corresponding to the leaves and therefore it turns in the same sheet.
I'll attach a sample table.
Example:
In sheet 2 (based search, compare) somewhere in column "G" has numbers 123456 (matches can be many), these numbers say repeated in sheet 6 (assuming that it is in blue color). Result which is to be obtained is that number (numbers) in the sheet 2 and the sheet 6 - must be blue.
I would be grateful if you could find a solution to my problem

[Bob Phillips]

Public Sub SearchColorGarry2()
Dim ws As Worksheet
Dim matchrow As Long
Dim lastrow As Long
Dim i As Long

With Worksheets("name1")

lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row
.Columns("G").Interior.ColorIndex = xlColorIndexNone
.Columns("G").Font.ColorIndex = xlColorIndexAutomatic
For i = 2 To lastrow

For Each ws In Worksheets

If Not ws.Name Like "dont touch*" And ws.Name <> "name1" Then

matchrow = 0
On Error Resume Next
matchrow = Application.Match(.Cells(i, "G").Value, ws.Columns("G"), 0)
On Error GoTo 0
If matchrow > 0 Then

.Cells(i, "G").Interior.Color = ws.Tab.Color
.Cells(i, "G").Font.Color = vbWhite
Exit For
End If
End If
Next ws
Next i
End With
End Sub

[k0st4din]

Thank you very much, I just have no words to express my gratitude.
I have just one question - why did not you paint the matches and in the corresponding intentions sheet - this can you get a solution?
Ie in sheet with name - "name1" them colored, but the sheets where the coincidence is not it painted.
I hope you can handle.
Thank you in advance

[Bob Phillips]

I didn't do it because it seemed pointless to me


Public Sub SearchColorGarry2()
Dim ws As Worksheet
Dim matchrow As Long
Dim lastrow As Long
Dim i As Long

With Worksheets("name1")

lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row
.Columns("G").Interior.ColorIndex = xlColorIndexNone
.Columns("G").Font.ColorIndex = xlColorIndexAutomatic
For i = 2 To lastrow

For Each ws In Worksheets

If Not ws.Name Like "dont touch*" And ws.Name <> "name1" Then

matchrow = 0
On Error Resume Next
matchrow = Application.Match(.Cells(i, "G").Value, ws.Columns("G"), 0)
On Error Goto 0
If matchrow > 0 Then

With .Cells(i, "G")

.Interior.Color = ws.Tab.Color
.Font.Color = vbWhite
End With

With ws.Cells(matchrow, "G")

.Interior.Color = ws.Tab.Color
.Font.Color = vbWhite
End With

Exit For
End If
End If
Next ws
Next i
End With
End Sub

[k0st4din]

Maybe it's pointless, but I need to be able once they find matches and then I go in the corresponding sheet to filter only hand colored.
Because it is still a small example but my database is very large and if I had to look for over 50 000 lines 5 matches - will be great fun. :)
Thank you infinitely many. :)
Be alive and well xld

[k0st4din]

Hello xld
I'm trying to do this search for matches start from the "G2" to the end, but it gives me an error. Is there any specifics about which I can not think? Or I do not know how to do it? I mean that G1 and G2 are constants and I do not need checking.
Thank you very much
P.S. - And another thing - I'm trying to give you reputation, but the site did not allow it. Do you have any idea or any other reason (that I have some opinions or something else)?

[Bob Phillips]

Sorry, I am not sure what you mean exactly. The code already starts at row 2, so G1 is not even looked at.

As for reputation, I have never used them so I have no idea how to go about giving them. To be honest with you, I am not sure what they are all about, they appear to have been cribbed from other sites (where they seem just as pointless) in an effort to try and suggest that VBAX is cool.

[snb]

Sub M_snb()
ReDim sn(Sheets.Count - 1)

For j = 1 To Sheets.Count
If Sheets(j).CodeName <> "Sheet1" Then
sn(j - 1) = Sheets(j).Columns(7).SpecialCells(2)
sn(j - 1)(1, 1) = Sheets(j).Name
End If
If Sheets(j).Name = "name1" Then y = j - 1
Next

For j = 2 To UBound(sn(y))
For jj = 2 To UBound(sn)
If j <> y Then x = IsError(Application.Match(sn(y)(j, 1), sn(jj), 0))
If Not x Then
sn(y)(j, 1) = sn(jj)(1, 1)
Exit For
End If
Next
Next

Sheets("name1").Columns(7).SpecialCells(2).Offset(, 2) = sn(y)
End Sub