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
    Posts
    1

    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
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    24,855

    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.
    Peter

    - 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
    Location
    England
    Posts
    1,092

    Default Re: Find duplicate values in column VBA

    Try this that was kindly supplied from this forum
    Code:
    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, _
            DataOption1:=xlSortNormal
    
    '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
            ws.Range("EE:EE").Clear
    
        Else
            ws.Range("EE:EE").Clear
            Oops = True
            GoTo ErrorExit
        End If
        
    'Turn on the autofilter, one column only is all that is needed
        ws.Range(vTitles).AutoFilter
    
    '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)
                Sheets(MyArr(Itm)).Cells.Clear
            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
            Sheets(MyArr(Itm)).Columns.AutoFit
        Next Itm
        
    'Cleanup
        ws.AutoFilterMode = False
        MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " _
                    & MyCount & vbLf & "Hope they match!!"
    
    ErrorExit:
        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
    VoG is offline
    MrExcel MVP
    Moderator
    VoG's Avatar
    Join Date
    Jun 2002
    Location
    127.0.0.1
    Posts
    61,564

    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
  •  


DMCA.com