VBA With / End With problem for Highlighting Duplicates

[weepingpea]

Dear all,

I have manipulated a code provided by another form user to highlight duplicate values in multiple sheets in a workbook. I have a Master sheet that contains all emails in column A, and I want to check 5 separate worksheets against this Master for duplicates. All the data for cross-referencing are in column A.

The code worked when comparing across 2 sheets. However, when I iterated it for 5 sheets I get error messages that say "Compilation error: Expected End With". I tried adding "End With" in different places but that just triggers another error saying "Compilation Error: End without With."

This is my first ever VBA code. I would really appreciate it if someone could point out what I am doing wrong! Many thanks for your help in advance!

I am using Windows Excel 2010. I cannot post the original file because it contains confidential information. However, I will include a link to a dummy spreadsheet below.

Note: ideally I want this macro to be functional across 10 sheets. The people I am programming for a not tech savvy at all. They frequently have to compare multiple spreadsheets for duplicates, sets vary from 5 up to 10 sheets. I don't know if it is possible to have codes running up to 10 iterations for sheets that might not be in the book.

Sub HighliteDupes()
' hiker95, 08/18/2014, ME799751
Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, a As Range
Application.ScreenUpdating = False
Set w1 = Sheets("Master")
Set w2 = Sheets("MoscowProspects")
Set w3 = Sheets("MoscowPrevEvents")
Set w4 = Sheets("CVReview")
Set w5 = Sheets("InProgress")
Set w6 = Sheets("AllInvites")


With w1
  For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    Set a = w2.Columns(1).Find(c.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      c.Interior.Color = vbYellow
      w2.Cells(a.Row, 1).Interior.Color = vbYellow
      Set a = Nothing
    End If
  Next c
End With
With w2
  For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    Set a = w1.Columns(1).Find(c.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      c.Interior.Color = vbYellow
      w1.Cells(a.Row, 1).Interior.Color = vbYellow
      Set a = Nothing
    End If
  Next c
With w3
  For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    Set a = w1.Columns(1).Find(c.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      c.Interior.Color = vbYellow
      w1.Cells(a.Row, 1).Interior.Color = vbYellow
      Set a = Nothing
    End If
  Next c
With w4
  For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    Set a = w1.Columns(1).Find(c.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      c.Interior.Color = vbYellow
      w1.Cells(a.Row, 1).Interior.Color = vbYellow
      Set a = Nothing
    End If
  Next c
With w5
  For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    Set a = w1.Columns(1).Find(c.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      c.Interior.Color = vbYellow
      w1.Cells(a.Row, 1).Interior.Color = vbYellow
      Set a = Nothing
    End If
  Next c
With w6
  For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    Set a = w1.Columns(1).Find(c.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      c.Interior.Color = vbYellow
      w1.Cells(a.Row, 1).Interior.Color = vbYellow
      Set a = Nothing
      End If
      End With
    Next c
End With


Application.ScreenUpdating = True
End Sub

 

[RCBricker]

This has not been tested. But it might do everything you are doing in less code

Sub YellowDups()

Dim Lrow As Long, LrowNM As Long
Dim ws As Worksheet, wsM As Worksheet, wsNM As Worksheet
Dim rng As Range, rngnm As Range, cell As Range, cellnm As Range


Application.ScreenUpdating = False

    Set wsM = Sheets("Master")
    With wsM
        Lrow = Range("A" & .Rows.Count).End(xlUp).Row
        Set rng = Range(.Cells(2, 1), .Cells(Lrow, 1))
        For Each cell In rng
            If Not cell.Interior.ColorIndex = -4142 Then
            Else
                For Each wsNM In Worksheets
                    If wsNM.Name = "Master" Then
                    Else
                        With wsNM
                            LrowNM = Range("A" & .Rows.Count).End(xlUp).Row
                            Set rngnm = Range(.Cells(2, 1), .Cells(LrowNM, 1))
                                For Each cellnm In rngnm
                                    If cellnm.Value = cell.Value Then
                                        cellnm.Interior.Color = vbYellow
                                        cell.Interior.Color = vbYellow
                                    End If
                                Next cellnm
                        End With
                    End If
                Next wsNM
            End If
        Next cell
        
    End With

End Sub

rich

 

[hiker95]

weepingpea,

I could not understand why I could not find my test workbook from my archives.

Here is the original macro code that I wrote for Callum90, that did work correctly.

Sub HighliteDupes()
' hiker95, 08/18/2014, ME799751
Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, a As Range
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
With w1
  For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    Set a = w2.Columns(1).Find(c.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      c.Interior.Color = vbYellow
      w2.Cells(a.Row, 1).Interior.Color = vbYellow
      Set a = Nothing
    End If
  Next c
End With
With w2
  For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    Set a = w1.Columns(1).Find(c.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      c.Interior.Color = vbYellow
      w1.Cells(a.Row, 1).Interior.Color = vbYellow
      Set a = Nothing
    End If
  Next c
End With
Application.ScreenUpdating = True
End Sub

Your modification of the original macro did not contain most of the End With statements that you would have needed to make your macro work correctly.

 

[weepingpea]

Hi hiker95 and RoryA,

Apologies about the link. I think this should work (I have turned on public sharing).

Cheers,

weepingpea

 

[RoryA]

Apologies - this line in my original code (which I have amended above):

    With w

shoudl read:

    With w1

 

[weepingpea]

Hi RoryA,

Thank you for the correction. The code works now (see here). However, it only compared Sheet1 and Sheet5 with the Master. The duplicated in Sheet2, Sheet3 and Sheet4 weren't highlighted.

Don't worry - you don't have to keep working on this. Just FYI

weepingpea

 

[RoryA]

It is comparing them, but you'll note the other three sheets have formulas, not literal text, so you have to tell Find to look at the values:

                Set a = w.Columns(1).Find(c.Value, LookAt:=xlWhole, LookIn:=xlValues)