Find duplicate values in column VBA

Thanks Thanks:  0
Likes Likes:  0
Results 1 to 4 of 4

Thread: Find duplicate values in column VBA

  1. #1
    New Member
    Join Date
    Apr 2011
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Default Find duplicate values in column VBA

    Hi all,
    I want to create a macro which loops through all the cells from a certain row(which will be filtered alphabetically by me before running the macro - just to ease the work) and if it finds the same values in the cells below, to write their respective values from other rows in a new sheet and then export it(this part is already take care of). E.g. :
    Column A | Column B
    Value 1 | 2
    Value 1 | 3
    Value 2 | 1
    Value 2 | 14
    Value 2 | 15
    Value 3 | 1
    So in the end i would need 3 sheets printed: first sheet with values 2 and 3, second sheet with values 1, 14 & 15 and third sheet with value 1.

    Thank you very much in advance.

  2. #2
    MrExcel MVP
    Peter_SSs's Avatar
    Join Date
    May 2005
    Macksville, Australia
    Post Thanks / Like
    25 Post(s)
    1 Thread(s)

    Default Re: Find duplicate values in column VBA

    Welcome to the MrExcel board!

    See if you can make use of my suggestions in this thread. make sure you check the assumptions as well as the code.
    Hope this helps, good luck.
    Excel 365 + Excel 2010, 2007 - Windows 10, 7
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the VBHTML Maker
    - Read: Forum Rules & Forum Use Guidelines

  3. #3
    Board Regular pboltonchina's Avatar
    Join Date
    Apr 2008
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Default Re: Find duplicate values in column VBA

    Try this that was kindly supplied from this forum
    Option Explicit
    Sub ParseItems()
    'Jerry Beaucaire  (11/11/2009)
    'Based on selected column, data is filtered to individual sheets
    'Creates sheets and sorts sheets alphabetically in workbook
    '6/10/2010 - added check to abort if only one value in vCol
    Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
    Dim ws As Worksheet, MyArr As Variant, vTitles As String, Oops As Boolean
    Application.ScreenUpdating = False
    'Column to evaluate from, column A = 1, B = 2, etc.
       vCol = 1
    'Sheet with data in it
       Set ws = Sheets("Data")
    'Range where titles are across top of data, as string, data MUST
    'have titles in this row, edit to suit your titles locale
        vTitles = "A1:E1"
    'Spot bottom row of data
       LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
    'Get a temporary list of unique values from column A
        ws.Columns(vCol).SpecialCells(xlConstants).AdvancedFilter Action:=xlFilterCopy, _
            CopyToRange:=ws.Range("EE1"), Unique:=True
    'Sort the temporary list
        ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), _
            Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
            MatchCase:=False, Orientation:=xlTopToBottom, _
    'Check for more than one value in list
        If ws.Range("EE" & Rows.Count).End(xlUp).Row > 2 Then
    'Put list into an array for looping
    '(values cannot be the result of formulas, must be constants)
            MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" _
                & Rows.Count).SpecialCells(xlCellTypeConstants))
    'clear temporary worksheet list
            Oops = True
            GoTo ErrorExit
        End If
    'Turn on the autofilter, one column only is all that is needed
    'Loop through list one value at a time
        For Itm = 1 To UBound(MyArr)
            ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)
            If Not Evaluate("=ISREF('" & MyArr(Itm) & "'!A1)") Then    'create sheet if needed
                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(Itm)
            Else                                                      'clear sheet if it exists
                Sheets(MyArr(Itm)).Move After:=Sheets(Sheets.Count)
            End If
        'customize this section as needed for copy/paste targets
            ws.Range("A" & ws.Range(vTitles).Resize(1, 1).Row & ":A" & LR) _
                .EntireRow.Copy Sheets(MyArr(Itm) & "").Range("A1")
            ws.Range(vTitles).AutoFilter Field:=vCol
            MyCount = MyCount + Sheets(MyArr(Itm)) _
                .Range("A" & Rows.Count).End(xlUp).Row - 1
        Next Itm
        ws.AutoFilterMode = False
        MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " _
                    & MyCount & vbLf & "Hope they match!!"
        If Oops Then MsgBox "Only one value found, aborting parse process..."
        Application.ScreenUpdating = True
    End Sub
    When you wake up in the morning, stretch your arms out and if you don't feel any wood - Smile

  4. #4
    MrExcel MVP VoG's Avatar
    Join Date
    Jun 2002
    Post Thanks / Like
    0 Post(s)
    1 Thread(s)

    Default Re: Find duplicate values in column VBA

    HTH, Peter
    Please test any code on a copy of your workbook.

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts