Looking for dups numbers in groups of numbers in single column

JTL9161

Well-known Member
Joined
Aug 29, 2012
Messages
582
Office Version
  1. 365
Platform
  1. Windows
I have a column of numbers. I watered them down for this example below.

I am looking for a macro that will search EACH GROUP of numbers and find any dups. If there are none then go on to the next group and so on. I am not trying to find dup numbers in the entire column, just in each group.

After it finds a dupe I need it to note in a previous column.

The group size will be larger and vary in size but there should be at least 1 empty line between each grouping.

I've tried the macro's that look at the entire column but nothing seems to work for what I need.

Thanks for your help
James


<colgroup><col style="width:48pt" span="2" width="64"> </colgroup><tbody>
[TD="class: xl63, width: 64"] [/TD]
[TD="class: xl63, width: 64"] [/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]26[/TD]

[TD="class: xl63"]Dupe[/TD]
[TD="class: xl63, align: right"]34[/TD]

[TD="class: xl63"]Dupe[/TD]
[TD="class: xl63, align: right"]34[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]42[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]9[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]15[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]17[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]22[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]22[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]

[TD="class: xl63"]Dupe[/TD]
[TD="class: xl63, align: right"]2[/TD]

[TD="class: xl63"]Dupe[/TD]
[TD="class: xl63, align: right"]2[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]13[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]14[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]49[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]2[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]6[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]14[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]21[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]28[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]

[TD="class: xl63"]Dupe[/TD]
[TD="class: xl63, align: right"]1[/TD]

[TD="class: xl63"]Dupe[/TD]
[TD="class: xl63, align: right"]1[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]8[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]11[/TD]

[TD="class: xl63"] [/TD]
[TD="class: xl63, align: right"]24



[/TD]

</tbody>
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Try this:

Code:
Sub Button1_Click()
Dim grpStart As Integer
Dim grpEnd As Integer
Dim searchNum As Integer
Dim numMatches As Integer
Dim i As Integer
Dim continue As Boolean

'Constants
Dim searchCol As Integer
searchCol = 2
Dim startRow As Integer
startRow = 1

continue = True

Do Until continue = False
    
    'Find the first group
    For grpStart = startRow To (startRow + 20)
        If Not Cells(grpStart, searchCol).Value = "" Then
            Exit For
        End If
        'Exit the loop if no new group is detected
        If grpStart = (startRow + 20) Then
            continue = False
            Exit Do
        End If
    Next
        
    For grpEnd = grpStart To (grpStart + 999)
        If Cells(grpEnd, searchCol).Value = "" Then
            grpEnd = grpEnd - 1
            Exit For
        End If
    Next
    
    'Find the duplicates
    For i = grpStart To grpEnd
        searchNum = Cells(i, 2).Value
        numMatches = 0
            For a = grpStart To grpEnd
                If Cells(a, searchCol).Value = searchNum Then
                    numMatches = numMatches + 1
                End If
            Next
        If numMatches > 1 Then
            Cells(i, searchCol - 1).Value = "Dupe"
        End If
    Next
    startRow = grpEnd + 1


Loop
End Sub

Modify the searchCol and startRow fields to specify where your data is.
 
Upvote 0
With your data starting in B1, this will put Dupe into Col A
Code:
Sub FindDupe()

    Dim Ar As Areas
    Dim Rng As Range
    Dim Cl As Range
    
    Set Ar = Columns(2).SpecialCells(xlConstants).Areas
    For Each Rng In Ar
        For Each Cl In Rng
            If WorksheetFunction.CountIf(Rng, Cl) > 1 Then Cl.Offset(, -1).Value = "Dupe"
        Next Cl
    Next Rng

End Sub
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
I guess I did not give enough info in my first post because after using your macro I thought I could tweak it to better work with my spreadsheet but I guess I watered it down to much.

When it moves to the left and puts the "DUPE" label in, there is another column to the left I need to correct the sequence. I thought I could just add a few more steps in after the "DUPE" was added but the active cell does not move when your macro is running so after "DUPE" is labeled I can not make anymore moves.

To be simple (again) after "DUPE is added (say in column "B", with data in "C") I have a A-B-C-D-E..etc. When the "DUPE is added for example to B1 & B2 I need the macro to also take the sequence letter in A1 (the "A") and copy or replicate it in cell A2 which was a "B". Basically if there is a DUPE in cells C1 and C2 I need the sequence letters in A1 and A2 to be A's.

A DUPE 55
B DUPE 55
C 60

this above should look like:
A DUPE 55
A DUPE 55
C 60

Any MORE help will be appreciated.

Thanks,
James
 
Upvote 0
I had forgotten that @lbobbio1988 had also posted to this thread, so not sure who's code you are using.
Also not entirely what you are asking for now, but if you simply want A in column for each Dupe try this
Code:
Sub FindDupe()

    Dim Ar As Areas
    Dim Rng As Range
    Dim Cl As Range
    
    Set Ar = Columns(3).SpecialCells(xlConstants).Areas
    For Each Rng In Ar
        For Each Cl In Rng
            If WorksheetFunction.CountIf(Rng, Cl) > 1 Then
                Cl.Offset(, -1).Value = "Dupe"
                Cl.Offset(, 2).Value = "A"
            End If
        Next Cl
    Next Rng

End Sub
 
Last edited:
Upvote 0
WARNING:
There is a typo in my previous post. It should be
Code:
Cl.Offset(, [COLOR=#ff0000]-2[/COLOR]).Value = "A"
 
Upvote 0
I am using your code. It was working the best.

Let me clarify a little more.

The letters in column A will vary. In my example I needed the A brought down and copied over the B as the 2nd DUPE. Since the dupes can be anywhere between A and Z depending on the size of the group of numbers, after the DUPE is added I need it (I think) to copy the letter in (for example) A1 ("A") to cell A2

another example would be:

A 555
B 799
C DUPE 800
D DUPE 800
E 667

For this I would need the letter "C" copied over the letter "D"
A 555
B 799
C DUPE 800
C DUPE 800
E 667

Sorry for the back and forth with this. I am trying to clean up a rather large text file I got off our main frame and imported to Excel It will something I will be doing weekly and I am trying to get it into a more usable format before making my manual updates.

The DUPE thing and copying over of letters is just for my usage to make it so I can quickly find those from the (up to 10,000) lines of data coming over.

Thanks again
James
 
Upvote 0
OK, how about
Code:
Sub FindDupe()

    Dim Ar As Areas
    Dim rng As Range
    Dim Cl As Range
    Dim Val As String
    
    Set Ar = Columns(3).SpecialCells(xlConstants).Areas
    For Each rng In Ar
        Val = ""
        For Each Cl In rng
            If WorksheetFunction.CountIf(rng, Cl) > 1 Then
                Cl.Offset(, -1).Value = "Dupe"
                If Val = "" Then
                    Val = Cl.Offset(, -2).Value
                Else
                    Cl.Offset(, -2).Value = Val
                End If
            End If
        Next Cl
    Next rng

End Sub
 
Upvote 0

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

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