Results 1 to 6 of 6

Thread: macro or other ways to arrange columns so that there will be no consecutive duplicates
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Oct 2008
    Posts
    26
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default macro or other ways to arrange columns so that there will be no consecutive duplicates

    Hi Everyone,

    I have a table of two columns, one column for dates and the other column with duplicates items.

    I was wondering if there is a macro to arrange the 1st column by dates, and the second column with no consecutive duplicates (i.e. as much as possible as sometimes there is no way to avoid consecutive duplicates).

    I am sure this can be done but I just can't figure it out.

    Below is a "before and after" tables showing what I am trying to achieve, in case I wasn't clear about it. Thanks for helping out.

    Before After
    1 jan 2019 a 1 jan 2019 a
    1 jan 2019 a 1 jan 2019 b
    1 jan 2019 b 1 jan 2019 a
    1 jan 2019 b 1 jan 2019 b
    1 jan 2019 b 1 jan 2019 b
    2 jan 2019 d 2 jan 2019 d
    2 jan 2019 d 2 jan 2019 e
    2 jan 2019 e 2 jan 2019 d
    3 jan 2019 f 3 jan 2019 f
    3 jan 2019 f 3 jan 2019 g
    3 jan 2019 g 3 jan 2019 f
    3 jan 2019 g 3 jan 2019 g
    3 jan 2019 g 3 jan 2019 h
    3 jan 2019 h 3 jan 2019 g
    4 jan 2019 k 4 jan 2019 k
    4 jan 2019 k 4 jan 2019 m
    4 jan 2019 k 4 jan 2019 l
    4 jan 2019 k 4 jan 2019 k
    4 jan 2019 m 4 jan 2019 l
    4 jan 2019 l 4 jan 2019 k
    4 jan 2019 l 4 jan 2019 k


    cheers,
    ryuryuryu

  2. #2
    Board Regular
    Join Date
    Jan 2012
    Posts
    836
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: macro or other ways to arrange columns so that there will be no consecutive duplicates

    Try this

    Code:
    Public Sub RemoveDups()
    Dim lastrow As Long
        With ActiveSheet
        
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            
            .Sort.SortFields.Clear
            .Sort.SortFields.Add2 Key:=Range("A2").Resize(lastrow - 1), _
                                  SortOn:=xlSortOnValues, _
                                  Order:=xlAscending, _
                                  DataOption:=xlSortNormal
            .Sort.SortFields.Add2 Key:=Range("B2").Resize(lastrow - 1), _
                                  SortOn:=xlSortOnValues, _
                                  Order:=xlAscending, _
                                  DataOption:=xlSortNormal
            With .Sort
                .SetRange Range("A1:B1").Resize(lastrow)
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            .Range("A1:B$1").Resize(lastrow).RemoveDuplicates Columns:=Array(1, 2), _
                                                              Header:=xlYes
        End With
    End Sub

  3. #3
    New Member
    Join Date
    Oct 2008
    Posts
    26
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: macro or other ways to arrange columns so that there will be no consecutive duplicates

    Quote Originally Posted by theBardd View Post
    Try this

    Code:
    Public Sub RemoveDups()
    Dim lastrow As Long
        With ActiveSheet
        
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            
            .Sort.SortFields.Clear
            .Sort.SortFields.Add2 Key:=Range("A2").Resize(lastrow - 1), _
                                  SortOn:=xlSortOnValues, _
                                  Order:=xlAscending, _
                                  DataOption:=xlSortNormal
            .Sort.SortFields.Add2 Key:=Range("B2").Resize(lastrow - 1), _
                                  SortOn:=xlSortOnValues, _
                                  Order:=xlAscending, _
                                  DataOption:=xlSortNormal
            With .Sort
                .SetRange Range("A1:B1").Resize(lastrow)
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            .Range("A1:B$1").Resize(lastrow).RemoveDuplicates Columns:=Array(1, 2), _
                                                              Header:=xlYes
        End With
    End Sub

    Hi theBardd,

    I tried to run the code and got the following error message:

    "vba runtime error 438: Object doesn't support this property or method"

    When I pressed the debug button, the following code are highlighted:

    .Sort.SortFields.Add2 Key:=Range("A2").Resize(lastrow - 1), _ SortOn:=xlSortOnValues, _
    Order:=xlAscending, _
    DataOption:=xlSortNormal

    I am running the code in Excel 2016. I am not sure if that's the reason why it didn't work.

    Also, though I cannot run the code to test it, I noticed that RemoveDuplicates was used. I am trying to rearrange the rows so that there is no consecutive duplicates in the column with Column header "Item". The total number of rows of the table should be the same after the macro is run as I am not trying to delete the duplicates. Thanks.

    Before the macro is run:

    Date Item
    1 Jan 2019 a
    1 Jan 2019 a
    1 Jan 2019 b
    2 Jan 2019 c
    2 Jan 2019 c
    2 Jan 2019 c
    2 Jan 2019 d
    2 Jan 2019 d
    2 Jan 2019 e



    After the macro is run:
    Date Item
    1 Jan 2019 a
    1 Jan 2019 b
    1 Jan 2019 a
    2 Jan 2019 c
    2 Jan 2019 d
    2 Jan 2019 c
    2 Jan 2019 d
    2 Jan 2019 c
    2 Jan 2019 e


    cheers,
    ryuryuryu

  4. #4
    Board Regular
    Join Date
    Jan 2012
    Posts
    836
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: macro or other ways to arrange columns so that there will be no consecutive duplicates

    I'm using Excel 16 so iut should work, but see if this works better for you

    Code:
    Public Sub RemoveDups()
    Dim lastrow As Long
        With ActiveSheet
        
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            
            .Range("A1:B1").Resize(lastrow).Sort Key1:=Range("A2"), _
                                                 Order1:=xlAscending, _
                                                 Header:=xlYes
            
            .Range("A1:B$1").Resize(lastrow).RemoveDuplicates Columns:=Array(1, 2), _
                                                              Header:=xlYes
        End With
    End Sub
    Last edited by theBardd; May 18th, 2019 at 02:14 PM.

  5. #5
    Board Regular
    Join Date
    Jan 2012
    Posts
    836
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: macro or other ways to arrange columns so that there will be no consecutive duplicates

    Okay, I've read it properly now and see what you are trying to do.

    Take a shot with this (although it doesn't quite work with your first set)

    Code:
    Public Sub ReorderDups()
    Dim ordered As Boolean
    Dim lastrow As Long
    Dim i As Long
        With ActiveSheet
        
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            
            Do
            
            ordered = True
            
                For i = 2 To lastrow
            
                    If .Cells(i, "A").Value = .Cells(i - 1, "A").Value And _
                        .Cells(i, "B").Value = .Cells(i - 1, "B").Value Then
                        
                        .Cells(i, "A").Resize(, 2).Cut
                        .Cells(i + 2, "A").Resize(, 2).Insert Shift:=xlDown
            
                        ordered = False
                    End If
                Next i
            Loop Until ordered
        End With
    End Sub

  6. #6
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    23,078
    Post Thanks / Like
    Mentioned
    390 Post(s)
    Tagged
    41 Thread(s)

    Default Re: macro or other ways to arrange columns so that there will be no consecutive duplicates

    Best I could come up with

    In C1 & fill down
    =MOD(ROW(A1),SUM(COUNTIFS($A$1:$A$21,A1,$B$1:$B$21,$B$1:$B$21)))
    Then sort on column A & column C
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 2003 & 2013 on Win 7

Some videos you may like

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
  •