I could only thing of getting all the cells data in one column, then counting the duplicates.
Sub Button1_Click()
Dim sh As Worksheet, ws As Worksheet
Dim rng As Range, c As Range, r As Long
Dim rng2 As Range, c2 As Range, r2 As Long
Set ws = Sheets("Shhet 1")
ws.Columns("E:G").Clear
For Each sh In Sheets
With sh
If sh.Visible = True Then
Set rng = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
For Each c In rng
If c.Offset(, 1) <> "N/A" Then
r = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row + 1
ws.Cells(r, "G").End(xlUp).Offset(1) = c.Value
ws.Cells(r, "E").End(xlUp).Offset(1) = sh.Name
ws.Cells(r, "F").End(xlUp).Offset(1) = c.Address
End If
Next c
End If
End With
Next sh
With ws
Set rng2 = .Range("G2:G" & .Cells(.Rows.Count, "G").End(xlUp).Row)
rng2.Offset(, 1) = "=COUNTIF(G:G,G2)"
For Each c2 In rng2.Offset(, 1).Cells
If c2 > 1 Then
Sheets(c2.Offset(, -3).Value).Range(c2.Offset(, -2)).Interior.Color = vbYellow
End If
Next c2
End With
ws.Columns("E:H").Clear
End Sub
Looking forward to seeing the array experts solutions
Bookmarks