VBA With / End With problem for Highlighting Duplicates

W

weepingpea

New Member
Joined
Sep 7, 2015
Messages
9
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.

Rich (BB code):
Rich (BB code): 
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
 
Sort by date Sort by votes
You can download the dummy dataset here. You can find the code above in 'Sheet 1' -> view code. The desired output is for all duplicate values across all sheets to be highlighted in yellow.
 
Upvote 0
Try this version - note it assumes, as the original, that there will be a maximum of one match per email per sheet:

Code: 
Sub HighliteDupes()
' hiker95, 08/18/2014, ME799751
    Dim w1                    As Worksheet
    Dim w                     As Worksheet
    Dim c                     As Range
    Dim a                     As Range
    Application.ScreenUpdating = False
    Set w1 = Sheets("Master")


    With w1

        For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))

            For Each w In Sheets(Array("MoscowProspects", "MoscowPrevEvents", "CVReview", "InProgress"))

                Set a = w.Columns(1).Find(c.Value, LookAt:=xlWhole)
                If Not a Is Nothing Then
                    c.Interior.Color = vbYellow
                    w.Cells(a.Row, 1).Interior.Color = vbYellow
                    Set a = Nothing
                End If

            Next w

        Next c

    End With
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
weepingpea,

Thanks for your latest Private Message.

Please see my Private Message to you, in reference to the fact that you did not create Dim statements for w3, w4, w5, and, w6.
 
Upvote 0
Dear RoryA,

Thank you very much for the new code. It looks really cool. I have tried it with my dummy spreadsheet but it triggers an error message when I get to the line

For Each w In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5"))

The message says: Run-time error '91: Object variable or With block variable not set.

Do you know what is going on? You can find the file here. The code is in Sheet1.

Many thanks!

Teddy
 
Upvote 0
That is not a public link.
 
Upvote 0
weepingpea,

The following is a free site:

You can upload your workbook to (the BLUE link-->) Box Net ,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.
 
Upvote 0
weepingpea said:
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.

Rich (BB code):
Rich (BB code): 
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
Click to expand...

in your code each block with needs and end with. after the first with statement you no long close your withs.

Rich (BB code): 
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
End With
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
End With
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
End With
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
End With
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

this code has all the end withs that you need.

rich
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Problem with Cell Colouring - VBA
Replies
6
Views
183
Dinngz
D
Burrgogi
  • Question Question
Need some help with VBA - evaluating a string of numbers and from VLOOKUP routine.
Replies
2
Views
97
StephenCrump
S
A
  • Solved
need procedure by message box to inform what exactly missed month
Replies
2
Views
80
Ali M
A
E
  • Solved
Overflow error when adjusting chart datalabel
Replies
1
Views
97
Enigmatic999
E
7
  • Question Question
Excel find first cell string then find the second cell string and return address of the second cell
Replies
2
Views
106
bebo021999
B

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top