vba code find duplicates

asyamonique

Well-known Member
Joined
Jan 29, 2008
Messages
1,280
Office Version
  1. 2013
Platform
  1. Windows
Code:
Dim Rng As Range, Dub As Integer, Dn As Range, col As IntegerDim Dn2 As Range, c As Integer
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))


For Dub = 0 To 1
    Set Rng = Rng.Offset(, Dub)
        col = Dub + 8


    For Each Dn In Rng
        For Each Dn2 In Rng.Offset(, 2)
            If WorksheetFunction.CountIf(Rng.Offset(, 4), Dn) = 0 Then
                If Dn = Dn2 Then
                    c = c + 1
                    Cells(c, col) = Dn
                 End If
            End If
        Next Dn2
    Next Dn
c = 0
Next Dub

Good Day,
The code given above populating duplicate entries between 2 column "A-B &C-D"
Is it possible to alter that code which will get the datas in first 2 columns?
Thanks
 
Last edited:

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
I'm sure the code and the explanation makes sense to you but I'm lost. Can you explain -- without a code dump -- on what you want to do?
Code:
Dim Rng As Range, Dub As Integer, Dn As Range, col As IntegerDim Dn2 As Range, c As Integer
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))


For Dub = 0 To 1
    Set Rng = Rng.Offset(, Dub)
        col = Dub + 8


    For Each Dn In Rng
        For Each Dn2 In Rng.Offset(, 2)
            If WorksheetFunction.CountIf(Rng.Offset(, 4), Dn) = 0 Then
                If Dn = Dn2 Then
                    c = c + 1
                    Cells(c, col) = Dn
                 End If
            End If
        Next Dn2
    Next Dn
c = 0
Next Dub

Good Day,
The code given above populating duplicate entries between 2 column "A-B &C-D"
Is it possible to alter that code which will get the datas in first 2 columns?
Thanks
 
Upvote 0
Hi,
Please chek below sample,
Just trying to get the duplicates from two columns.
Sorry for the late reply by the way!

COLUMN ACOLUMN B COLUMN DCOLUMN E
APPLE1234 APPLE1234
ORANGE7654 ORANGE7654
MELON3456 MELON3456
APPLE1234 LEMON4378
ORANGE7654
MELON3456
APPLE1234
ORANGE7654
MELON3456
APPLE1234
ORANGE7654
MELON3456
APPLE1234
LEMON4378

<colgroup><col span="5"></colgroup><tbody>
</tbody>
 
Upvote 0
It is still hazy to me. Do you just want to find the duplicates in columns A and B, where the values in both columns are repeated in other rows, or do you want to match them to columns D & E? Or do you want the found duplicates in A and B listed in D and E as Unique Values? Or what exactly do you want done with the duplicates once found?
 
Upvote 0
Hi asyamonique,

Based on the assumption that you're only checking for uniques in Col. A try this:

Code:
Option Explicit
Sub Macro1()

    Dim rngCell     As Range
    Dim lngMyRow    As Long
    Dim wsSourceTab As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsSourceTab = Sheets("Sheet1") 'Sheet name with data. Change to suit.

    With CreateObject("Scripting.Dictionary")
        For Each rngCell In wsSourceTab.Range("A2:A" & wsSourceTab.Range("A" & Rows.Count).End(xlUp).Row) 'Works down from cell A2. Change to suit.
            If Len(rngCell.Value) > 0 Then
                If Not .Exists(rngCell.Value) Then
                    .Add rngCell.Value, rngCell.Value
                    If lngMyRow = 0 Then
                        lngMyRow = 2 'Initial output row is 2. Change to suit.
                    Else
                        lngMyRow = lngMyRow + 1
                    End If
                    wsSourceTab.Range("A" & rngCell.Row & ":B" & rngCell.Row).Copy Destination:=wsSourceTab.Range("C" & lngMyRow)
                End If
            End If
        Next rngCell
    End With
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert
 
Last edited:
Upvote 0
Trebor,
If you don't mind could you help me for the sample below as well?
Thats for single column..
Thanks;)

COLUMN ACOLUMN B
100007211100007211
100007291100007291
100001196100001196
100007214100007214
100007235100007235
100007205100007205
100007211
100007291
100001196
100007214
100007235
100007205
100007211
100007291
100001196
100007214
100007235
100007205
100007211
100007291
100001196
100007214
100007235
100007205
100007211
100007291
100001196
100007214
100007235
100007205
100007211
100007291
100001196
100007214
100007235
100007205
100007211
100007291
100001196

<colgroup><col span="2"></colgroup><tbody>
</tbody>
 
Upvote 0
Hi Joe4,
First one was base on vba code request,
Second was a formula request,
Sorry for it anyway
Cheers
 
Upvote 0
Note sure why you want a VBA and formula solution as you can only use one or the other but for my macro you just need to change this line of code...

Code:
wsSourceTab.Range("A" & rngCell.Row & ":B" & rngCell.Row).Copy Destination:=wsSourceTab.Range("C" & lngMyRow)

...to this:

Code:
wsSourceTab.Range("A" & rngCell.Row).Copy Destination:=wsSourceTab.Range("B" & lngMyRow)

Regards,

Robert
 
Upvote 0

Forum statistics

Threads
1,214,587
Messages
6,120,406
Members
448,958
Latest member
Hat4Life

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