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!!

 

[offthelip]

There certainly is a much faster and better way of searching for duplicates and this is by using the VBA dictionary object.
You stated you wanted the cells positions noted but not really stated how you wanted them noted. In this code I have created a new column for each sheets which specifes the cell address where the duplicate is for each of the sheets. I have written this out starting at column B on "Sheet1" , but it is easily moved somewhere else just by modfifying the last line. I have created an array at the start to define which sheets you want searched. (shtname)

Sub test()
' this shows hte use of a dictionary
  shtname = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5") ' Modify to list the sheet you want searched
   Dim Ary As Variant
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
  
   Set Dic = CreateObject("Scripting.dictionary")
   Worksheets("Sheet1").Select
   lastrow = Cells(Rows.Count, "A").End(xlUp).Row
      Ary = Range(Cells(1, 1), Cells(lastrow, 1))
      Range(Cells(1, 2), Cells(lastrow, 5)) = ""
      outarr = Range(Cells(1, 2), Cells(lastrow, 5))
  
   For i = 1 To UBound(Ary)
      Dic(Ary(i, 1)) = i
   Next i
  For j = 0 To UBound(shtname)
   With Worksheets(shtname(j))
      lastrow2 = .Cells(Rows.Count, "A").End(xlUp).Row
      Ary2 = .Range(.Cells(1, 1), .Cells(lastrow2, 1))
     
   End With
   For i = 1 To lastrow2
      If Dic.Exists(Ary2(i, 1)) Then
         outarr(Ary2(i, 1), 1 + j) = "A" & i
      End If
   Next i
  Next j
Range(Cells(1, 2), Cells(lastrow, 5)) = outarr ' change this to write the results out somehwere else
End Sub

 

[Nuke_It_Newport]

There certainly is a much faster and better way of searching for duplicates and this is by using the VBA dictionary object.

You stated you wanted the cells positions noted but not really stated how you wanted them noted. In this code I have created a new column for each sheets which specifes the cell address where the duplicate is for each of the sheets. I have written this out starting at column B on "Sheet1" , but it is easily moved somewhere else just by modfifying the last line. I have created an array at the start to define which sheets you want searched. (shtname)

Sub test()

' this shows hte use of a dictionary

  shtname = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5") ' Modify to list the sheet you want searched

   Dim Ary As Variant

   Dim i As Long

   Dim Dic As Object

   Dim Cl As Range

 

   Set Dic = CreateObject("Scripting.dictionary")

   Worksheets("Sheet1").Select

   lastrow = Cells(Rows.Count, "A").End(xlUp).Row

      Ary = Range(Cells(1, 1), Cells(lastrow, 1))

      Range(Cells(1, 2), Cells(lastrow, 5)) = ""

      outarr = Range(Cells(1, 2), Cells(lastrow, 5))

 

   For i = 1 To UBound(Ary)

      Dic(Ary(i, 1)) = i

   Next i

  For j = 0 To UBound(shtname)

   With Worksheets(shtname(j))

      lastrow2 = .Cells(Rows.Count, "A").End(xlUp).Row

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

   

   End With

   For i = 1 To lastrow2

      If Dic.Exists(Ary2(i, 1)) Then

         outarr(Ary2(i, 1), 1 + j) = "A" & i

      End If

   Next i

  Next j

Range(Cells(1, 2), Cells(lastrow, 5)) = outarr ' change this to write the results out somehwere else

End Sub

Thanks! I've heard of Scripting.dictionary, but have never used it. I haven't used arrays much either, for that matter. I'm digesting your code now, and I think I understand how it works. I'm going to plug it in and see if I can get it to work. When I said I needed the cell's positions noted, I was trying to say I want to use those locations to apply the formatting on the matching cell values on sheet 1. I know what I want to do, but can't always describe it properly. I have multiple conditions where I would like to apply this code.
The basic purpose of my spreadsheet is to import data from a third party application (Maximo), where I can sort and filter the data on an "Import" sheet. I then cut / copy and paste various rows into 5 separate "Workspace" sheets. From there, I can export each sheet into Google Maps, so I have pin drops for each location. When I complete the audits, I enter a completion date for each audit, and my code moves that row to a "Completed" worksheet. The next time I download the data from Maximo and import it into my spreadsheet via a Power Query, I need to flag the rows that are completed on my "Import" sheet. There's no way to sync the completed tasks back to Maximo, hence the need for this spreadsheet to track everything. There's more to it than that, but that's the gist of it. I'll mark as "Solved" when I get this working. Thanks again!

 

[offthelip]

When designing a system where you are planning to use VBA, it is worth being aware of what makes VBA slow. One of the slowest things that the code has to do is any interaction with the worksheet. So if you want to design fast efficient code it is best to minimise the number of interactions between the worksheet and the VBA If you are dealing with values as is the case with my code above, I can load thousands of rows into memory with one this statement:

Ary = Range(Cells(1, 1), Cells(lastrow, 1))

This takes about the same time as it does to access one cell. One can do a similar thing when writing back to the worksheet as I do with the last line.

The reason I am explaining this is that testing the format of a cell or to change the format of a cell you have read or write every cell individually. Thus using formatting to hold a piece of information is a very poor way of designing a system because it will make any VBA very slow.

Formatting is very useful for display purposes because humans can interpret it very well. Thus it should be used just for that. So rather than actually formatting the cells that have duplicates, what I suggest is that you paste the column/columns that my code produce somewhere in a spare column off to the right out of view and then use conditional formatting for the display on column A. This will allow you to get the same result but keep up the speed.

I draw you attention to a thread I responded to recently, where somebody was using color for logic and was complaining about it being slow!!
Public Function to run faster
Note is is worth learning how to use variant arrays it is the easiest way of learning to write super fast code

 

[Nuke_It_Newport]

When designing a system where you are planning to use VBA, it is worth being aware of what makes VBA slow. One of the slowest things that the code has to do is any interaction with the worksheet. So if you want to design fast efficient code it is best to minimise the number of interactions between the worksheet and the VBA If you are dealing with values as is the case with my code above, I can load thousands of rows into memory with one this statement:

Ary = Range(Cells(1, 1), Cells(lastrow, 1))

This takes about the same time as it does to access one cell. One can do a similar thing when writing back to the worksheet as I do with the last line.

The reason I am explaining this is that testing the format of a cell or to change the format of a cell you have read or write every cell individually. Thus using formatting to hold a piece of information is a very poor way of designing a system because it will make any VBA very slow.

Formatting is very useful for display purposes because humans can interpret it very well. Thus it should be used just for that. So rather than actually formatting the cells that have duplicates, what I suggest is that you paste the column/columns that my code produce somewhere in a spare column off to the right out of view and then use conditional formatting for the display on column A. This will allow you to get the same result but keep up the speed.

I draw you attention to a thread I responded to recently, where somebody was using color for logic and was complaining about it being slow!!
Public Function to run faster
Note is is worth learning how to use variant arrays it is the easiest way of learning to write super fast code

That's good info. Much appreciated. I have built a few things in MS Access, and had to learn how to write efficient code there. I do try to minimize interaction with the sheet when I can, but I'm not always sure what the best or available options are for any given operation. If I understand you correctly, I need to use Excel's built in conditional formatting to highlight the cells based on the corresponding values of "outarr" in your code. Looks like I've got a lot of learning ahead, and some redesigning to do in my spreadsheet. We're in the midle of a blizzard right now, so I've got plenty of time! Thanks again!

 

[Alex Blakenburg]

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

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

offthelip's code is the way to go but since you have spent hours trying to solve this you might want this addressed as well.
Unless you are not showing all your code there needs to be something like a "Set c =" line and a loop for getting the next "c" or a "For Each c in DstRng" (where you also need to Set DstRng)

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

 

[offthelip]

Whoops, I spotted an error in my code:
this line:

 outarr(Ary2(i, 1), 1 + j) = "A" & i

should be

 outarr(Dic(Ary2(i, 1)), 1 + j) = "A" & i

 

[Nuke_It_Newport]

offthelip's code is the way to go but since you have spent hours trying to solve this you might want this addressed as well.
Unless you are not showing all your code there needs to be something like a "Set c =" line and a loop for getting the next "c" or a "For Each c in DstRng" (where you also need to Set DstRng)

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

Thanks Alex. I had all the code in my post but wasn't aware of this. I've been sick for the last few days, so I haven't done any work on this. I'm going to work on implementing offthelip's method once my brain is back to firing on all cylinders. Thanks again!

 

[Nuke_It_Newport]

Whoops, I spotted an error in my code:
this line:

 outarr(Ary2(i, 1), 1 + j) = "A" & i

should be

 outarr(Dic(Ary2(i, 1)), 1 + j) = "A" & i

Thank you! I have your code in my workbook but haven't messed with it yet. I just did a find and replace to correct this code. Thanks again!

 

[Nuke_It_Newport]

There certainly is a much faster and better way of searching for duplicates and this is by using the VBA dictionary object.
You stated you wanted the cells positions noted but not really stated how you wanted them noted. In this code I have created a new column for each sheets which specifes the cell address where the duplicate is for each of the sheets. I have written this out starting at column B on "Sheet1" , but it is easily moved somewhere else just by modfifying the last line. I have created an array at the start to define which sheets you want searched. (shtname)

Sub test()
' this shows hte use of a dictionary
  shtname = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5") ' Modify to list the sheet you want searched
   Dim Ary As Variant
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
 
   Set Dic = CreateObject("Scripting.dictionary")
   Worksheets("Sheet1").Select
   lastrow = Cells(Rows.Count, "A").End(xlUp).Row
      Ary = Range(Cells(1, 1), Cells(lastrow, 1))
      Range(Cells(1, 2), Cells(lastrow, 5)) = ""
      outarr = Range(Cells(1, 2), Cells(lastrow, 5))
 
   For i = 1 To UBound(Ary)
      Dic(Ary(i, 1)) = i
   Next i
  For j = 0 To UBound(shtname)
   With Worksheets(shtname(j))
      lastrow2 = .Cells(Rows.Count, "A").End(xlUp).Row
      Ary2 = .Range(.Cells(1, 1), .Cells(lastrow2, 1))
    
   End With
   For i = 1 To lastrow2
      If Dic.Exists(Ary2(i, 1)) Then
         outarr(Ary2(i, 1), 1 + j) = "A" & i
      End If
   Next i
  Next j
Range(Cells(1, 2), Cells(lastrow, 5)) = outarr ' change this to write the results out somehwere else
End Sub

I worked with this code today and have an example sheet working! I now have a couple of follow up questions, if you don't mind.

• 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.

 If Dic.Exists(Ary2(i, 1)) Then

​

How would I allow for a blank sheet, or a sheet with only one entry to be checked?​

​

Thank you!!