Results 1 to 4 of 4

Find duplicate values in column VBA

This is a discussion on Find duplicate values in column VBA within the Excel Questions forums, part of the Question Forums category; Hi all, I want to create a macro which loops through all the cells from a certain row(which will be ...

  1. #1
    New Member
    Join Date
    Apr 2011

    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

    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.

    - Read: Posting Guidelines, Forum Rules & FAQs
    - Want to post a small screen shot? Try one of these Excel jeanie, MrExcel HTML Maker or Borders-Copy-Paste (To test: Test Here)
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the VBHTML Maker

  3. #3
    Board Regular pboltonchina's Avatar
    Join Date
    Apr 2008

    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
    VoG is offline
    MrExcel MVP
    VoG's Avatar
    Join Date
    Jun 2002

    Default Re: Find duplicate values in column VBA

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

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