• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to re-arrange duplicate values

ThrottleWorks

Excel Ninja
Hi,

I have a data. There are around 50 columns and 150 rows in this data.
Number of rows will vary but no of columns will remain same.

In this data, in column D, I have account numbers. This numbers are reflecting multiple times in this data. Column D is sorted from A to Z. That is why, duplicate account numbers are populated in serial order.

For example, if account number ABC 123 is repeated twice, it will be reflected in serial order, let’s say row 2 and 3.

Can we segregate duplicate account numbers.

I do want duplicate account numbers in serial order. If account ABC 123 is as row 2 then next instance should not be at row 3. Next instance of account ABC 123 should be populated anywhere after row 3 but not in row 3.

So, original order is, row 2 = ABC 123, row 3 = ABC 123, row 4 XYZ 123.
I want a solution which will re-shuffle data in following way.
row 2 = ABC 123, row 3 = XYZ 123, row 4 ABC 123.

Can anyone please help me in this.
 
Hi,

Can anyone please help me in this.

Same account numbers should not be populated in consecutive rows. Most of the account numbers are repeated for more than 4-5 times. I tried a loop but got stuck after removing first instance of duplicate.
 
Last edited:
A 12 years old boring boy - normal, not a genius - asked me
« What are you doing ? »
I explained your problem and after a while he came back and told me
« Easy in a two way process ! »
We manually tried his way with Excel basics and as it works,
this is its VBA translation with row #1 as headers and,
according to your poor sample, accounts in column B (and not D) :
(Edit for optimization …)​
Code:
Sub Demo()
        Dim Rg As Range, B&, C&, L&, N&, R&, S$, T&
        Application.ScreenUpdating = False
With Cells(1).CurrentRegion.Columns
            C = .Count + 1
            L = 2 - .Count
    With .Resize(, C)
            .Cells(C).Value = 0
            B = Application.CountBlank(.Columns(C)) - 1
            Set Rg = .Columns(C).Find("")
        Do
            If Rg.Row <= R Then
                T = Application.CountBlank(.Columns(C))
                If T = B Then Exit Do
                B = T
            End If
               R = Rg.Row
                If Rg(1, L).Value <> S Then N = N + 1: Rg.Value = N: S = Rg(1, L).Value
               Set Rg = .Columns(C).FindNext(Rg)
        Loop Until Rg Is Nothing
            .Sort .Cells(C), xlAscending, Header:=xlYes
        If Not Rg Is Nothing Then
           Set Rg = .Columns(C).Find("", .Cells(C), SearchDirection:=xlPrevious)
                B = Application.CountBlank(.Columns(C))
                R = .Rows.Count + 1
            Do
                If Rg.Row >= R Then
                    T = Application.CountBlank(.Columns(C))
                    If T = B Then Exit Do
                    B = T
                End If
                 R = Rg.Row
                 T = 0
                 S = Rg(1, L).Value
            Do While Rg(T).Row > 1
                If Rg(T, L).Value <> S And Rg(T - 1, L).Value <> S Then
                    Rg.Value = Rg(T - 1).Value
                    .Sort .Cells(C)
                    Exit Do
                Else
                    T = T - 1
                End If
            Loop
                   Set Rg = .Columns(C).FindNext(Rg)
            Loop Until Rg Is Nothing
        End If
            .Columns(C).Clear
    End With
End With
        Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 
Last edited:
Back
Top