Looping through sheets, Searching for duplicate in column using ".Find"

[Nuke_It_Newport]

Hey everyone-

I am attempting to perform the following:

• Loop through sheets 4 through 8 in a workbook.
  • Find any cell values in column "A" that match sheet 1 column "A", and note the cell positions (for example, A6, A19, A32).
  • Apply formatting to these cell positions in sheet 1 (for this example, A6, A19, A32).

I am getting an error setting the range from this line:

Set rng = SrcWS.Range("A:A").Find(c.Value, , xlValues, xlWhole)

I've worked on this for hours upon hours, and searched for a solution online.
Here's the code:

Option Explicit

Sub DoesNotWork()

Dim i As Integer
Dim StartIndex As Integer
Dim EndIndex As Integer
Dim SrcTbl As ListObject 'Source Table
Dim DstTbl As ListObject 'Destination Table
Dim c As Range
Dim rng As Range
Dim adr As String
Dim SrcWS As Worksheet  'Source Worksheet
Dim DstWS As Worksheet 'Destination worksheet

Set DstWS = Sheets("Import")
StartIndex = Worksheets(4).Index
EndIndex = Worksheets(8).Index

If StartIndex > 0 And EndIndex > 0 And EndIndex > StartIndex Then
    For i = StartIndex To EndIndex
        Set SrcWS = Worksheets(i)
        
        '    ****    THIS LINE IS THROWING ERROR...    *****
        Set rng = SrcWS.Range("A:A").Find(c.Value, , xlValues, xlWhole)
        
        If Not rng Is Nothing Then
            adr = rng.Address
            With DstWS
                c.Font.Color = RGB(51, 153, 51)   'Dark Green
                c.Font.Bold = True
            End With
            Do
            Set rng = SrcWS.Range("A:A").FindNext(rng)
            Loop While rng.Address <> adr
        End If
    Next i
End If

End Sub

I'm not sure if I need to use a different method altogether to search for duplicates, or if I've made a syntax error. If there's a more efficient way to compare columns, such as using an array, please let me know. Eventually I may search multiple columns for matches.
Thanks for your help!!

 

[bebo021999]

With sheet1 is formating sheet, sheet2 to 5 is source sheets
SstartR = 3 (adjustable)

Option Explicit
Sub test()
Dim lr&, i&, j&, startR&, k&, sh, rng
Dim dic As Object, ws As Worksheet
sh = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5")
startR = 3 ' row index from that to search
'------------------------------------------------------------------
'to store unique values in column A of every sheets into Dictionary
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(sh)
    Set ws = Sheets(sh(i))
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' last row on column A
    rng = ws.Range("A3", ws.Cells(lr, 1)).Value
    For j = 1 To lr - startR +1
        If Not dic.exists(rng(j, 1)) Then dic.Add rng(j, 1), ""
    Next
Next
'------------------------------------------------------------------
Sheets("Sheet1").Select
lr = Cells(Rows.Count, 1).End(xlUp).Row ' last row on column A
For i = 3 To lr
    With Cells(i, 1)
        .Font.Color = vbBlack
        .Font.Bold = False
        If dic.exists(.Value) Then ' if column A cell i found in dictionary then format
            .Font.Color = RGB(51, 153, 51)
            .Font.Bold = True
        End If
    End With
Next
Set dic = Nothing
End Sub

 

[offthelip]

• I want to move the range to start on row 3 on all the sheets (the reference sheet and the sheets to be compared). What do I need to modify? I've been attempting this, to no avail.
• I noticed if there are less than 2 populated rows on the sheets to be compared, I get a Run-Time error '13' Type mismatch error on the following line.

To start on row 3, the easiest way is to leave loading the arrays from row 1 because then the index as you loop through the array is the same as the row number. All you have to do is start the loop on row three, change these two lines:

  For i = 1 To UBound(Ary)

change to

  For i = 3 To UBound(Ary)

change this line

For i = 1 To lastrow2

to

For i = 3 To lastrow2

If there are less than 2 populated rows then the statement:

Ary2 = Range(Cells(1, 1), Cells(lastrow2, 1))

loads a single cell because Lastrow is 1. this means that Ary2 is NOT an array but just a single variable thus you get a type mismatch error
To avoid this just add a test for lastrow2 being greater than 1 lilke this:

For j = 0 To UBound(shtname)
   With Worksheets(shtname(j))
      Lastrow2 = .Cells(Rows.Count, "A").End(xlUp).Row
    If Lastrow2 > 1 Then
          Ary2 = .Range(.Cells(1, 1), .Cells(Lastrow2, 1))
        
        For i = 3 To Lastrow2  ' note chagne this to start of row 3
          If Dic.Exists(Ary2(i, 1)) Then
             outarr(Ary2(i, 1), 1 + j) = "A" & i
          End If
        Next i
    End If
   End With
  Next j

 

[Nuke_It_Newport]

With sheet1 is formating sheet, sheet2 to 5 is source sheets
SstartR = 3 (adjustable)

Option Explicit
Sub test()
Dim lr&, i&, j&, startR&, k&, sh, rng
Dim dic As Object, ws As Worksheet
sh = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5")
startR = 3 ' row index from that to search
'------------------------------------------------------------------
'to store unique values in column A of every sheets into Dictionary
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(sh)
    Set ws = Sheets(sh(i))
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' last row on column A
    rng = ws.Range("A3", ws.Cells(lr, 1)).Value
    For j = 1 To lr - startR +1
        If Not dic.exists(rng(j, 1)) Then dic.Add rng(j, 1), ""
    Next
Next
'------------------------------------------------------------------
Sheets("Sheet1").Select
lr = Cells(Rows.Count, 1).End(xlUp).Row ' last row on column A
For i = 3 To lr
    With Cells(i, 1)
        .Font.Color = vbBlack
        .Font.Bold = False
        If dic.exists(.Value) Then ' if column A cell i found in dictionary then format
            .Font.Color = RGB(51, 153, 51)
            .Font.Bold = True
        End If
    End With
Next
Set dic = Nothing
End Sub

Thank you! I ended up using this today with a few tweaks due to some changes / improvements in my workbook. I am comparing to one sheet and highlighting a certain color, comparing to another sheet and highlighting a different color, then comparing to 5 other sheets with a different color. This works perfect! Thanks!

 

[Nuke_It_Newport]

To start on row 3, the easiest way is to leave loading the arrays from row 1 because then the index as you loop through the array is the same as the row number. All you have to do is start the loop on row three, change these two lines:

  For i = 1 To UBound(Ary)

change to

  For i = 3 To UBound(Ary)

change this line

For i = 1 To lastrow2

to

For i = 3 To lastrow2

If there are less than 2 populated rows then the statement:

Ary2 = Range(Cells(1, 1), Cells(lastrow2, 1))

loads a single cell because Lastrow is 1. this means that Ary2 is NOT an array but just a single variable thus you get a type mismatch error
To avoid this just add a test for lastrow2 being greater than 1 lilke this:

For j = 0 To UBound(shtname)
   With Worksheets(shtname(j))
      Lastrow2 = .Cells(Rows.Count, "A").End(xlUp).Row
    If Lastrow2 > 1 Then
          Ary2 = .Range(.Cells(1, 1), .Cells(Lastrow2, 1))
       
        For i = 3 To Lastrow2  ' note chagne this to start of row 3
          If Dic.Exists(Ary2(i, 1)) Then
             outarr(Ary2(i, 1), 1 + j) = "A" & i
          End If
        Next i
    End If
   End With
  Next j

Thank you for your help! I knew I needed to test for Ary2 having less than 2 entries, I just couldn't quite wrap my head around how to code it. I attempted various changes to move the starting row but couldn't quite get it right. I'm saving this code for my next modification, as the functionality of returning which sheet the duplicate is found on will be useful. I learned a lot from working with this. It's one thing to understand how somebody's code works, and another entirely to write said code from scratch. I'm nowhere near that level of knowledge yet. Most of my code is reverse engineered, dissected, and reassembled from existing code somebody else wrote. You all are a HUGE resource!! I hope to return the favor someday.

 

[smozgur]

This works perfect! Thanks!

The marked solution post has been changed accordingly.