Page 1 of 2 12 LastLast
Results 1 to 10 of 17

Thread: Help with duplicate values move horizontally

  1. #1
    New Member sakis_s's Avatar
    Join Date
    Sep 2019
    Location
    Greece
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Question Help with duplicate values move horizontally

    Hi!
    I'm looking for a formula to do the following:

    I have:

    A B C D E F G H I
    1
    2040899
    54Z4
    2
    2037840
    3185
    3
    2037840
    4455
    4
    2037840
    5
    2038328
    3123
    6 2038328
    9999
    7
    2038190
    14B3
    8
    9

    And i need the following result:

    A B C D E F G H I
    1 2040899 54Z4
    2 2037840 3185 4455 7860
    3 2038328 3123 9999
    4 2038190 14B3
    5
    6
    7
    8
    9

    Removing duplicates from column A and entering Column B values from removed duplicates horizontally next to the first value.

    Anyone has any idea how to do that?

    Your help is much appreciated.

    Thank you very much for your time.

  2. #2
    MrExcel MVP
    Join Date
    May 2009
    Posts
    16,454
    Post Thanks / Like
    Mentioned
    36 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Help with duplicate values move horizontally

    Assuming the blank in B4 of your input data should be 7860, this will reconfigure the data starting in D1 to the format you want.
    Code:
    Sub sakis_s()
    'assumes first data entry is in cell A1
    ' Reformatted data begin in cell D1
    Dim R As Range, Vin As Variant, Vunique As Variant, Vout As Variant, i As Long, j As Long
    Dim Cols As Long
    Set R = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    Vin = R.Value
    ReDim Vout(1 To UBound(Vin, 1), 1 To UBound(Vin, 1))
    Application.ScreenUpdating = False
    Range("D1").CurrentRegion.ClearContents
    Rows(1).Insert
    [A1] = "HDR"
    With R.Columns(1).Offset(-1, 0).Resize(R.Rows.Count + 1)
        .AdvancedFilter Action:=xlFilterCopy, copytorange:=Range("D1"), unique:=True
    End With
    Rows(1).Delete
    Vunique = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value
    For i = 1 To UBound(Vunique, 1)
        For j = 1 To UBound(Vin, 1)
            If Vin(j, 1) = Vunique(i, 1) Then
                ct = ct + 1
                If ct > Cols Then Cols = ct
                Vout(i, ct) = Vin(j, 2)
            End If
        Next j
        ct = 0
    Next i
    Range(Cells(1, "E"), Cells(UBound(Vout, 1), Cols + Columns("E").Column)).Value = Vout
    Application.ScreenUpdating = True
    End Sub
    Joe

    When I was a young man I knew everything. Now that I'm older, I realize I know very little, and what I do know, I tend to forget!

  3. #3
    New Member sakis_s's Avatar
    Join Date
    Sep 2019
    Location
    Greece
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Help with duplicate values move horizontally

    Quote Originally Posted by JoeMo View Post
    Assuming the blank in B4 of your input data should be 7860, this will reconfigure the data starting in D1 to the format you want.
    Code:
    Sub sakis_s()
    'assumes first data entry is in cell A1
    ' Reformatted data begin in cell D1
    Dim R As Range, Vin As Variant, Vunique As Variant, Vout As Variant, i As Long, j As Long
    Dim Cols As Long
    Set R = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    Vin = R.Value
    ReDim Vout(1 To UBound(Vin, 1), 1 To UBound(Vin, 1))
    Application.ScreenUpdating = False
    Range("D1").CurrentRegion.ClearContents
    Rows(1).Insert
    [A1] = "HDR"
    With R.Columns(1).Offset(-1, 0).Resize(R.Rows.Count + 1)
        .AdvancedFilter Action:=xlFilterCopy, copytorange:=Range("D1"), unique:=True
    End With
    Rows(1).Delete
    Vunique = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value
    For i = 1 To UBound(Vunique, 1)
        For j = 1 To UBound(Vin, 1)
            If Vin(j, 1) = Vunique(i, 1) Then
                ct = ct + 1
                If ct > Cols Then Cols = ct
                Vout(i, ct) = Vin(j, 2)
            End If
        Next j
        ct = 0
    Next i
    Range(Cells(1, "E"), Cells(UBound(Vout, 1), Cols + Columns("E").Column)).Value = Vout
    Application.ScreenUpdating = True
    End Sub
    Wow Joe! That was really amazing! I can't thank you enough! I really appreciate your time, it works perfectly!

  4. #4
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    40,976
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    21 Thread(s)

    Default Re: Help with duplicate values move horizontally

    Another way that you could consider
    Code:
    Sub Rearrange()
      Dim d As Object
      Dim a As Variant
      Dim i As Long
      
      Set d = CreateObject("Scripting.Dictionary")
      a = Range("A1", Range("B" & Rows.Count).End(xlUp)).Value
      For i = 1 To UBound(a)
          d(a(i, 1)) = d(a(i, 1)) & ";" & a(i, 2)
      Next i
      Range("D1:E1").Resize(d.Count).Value = Application.Transpose(Array(d.Keys, d.Items))
      Range("E1").Resize(d.Count).TextToColumns DataType:=xlDelimited, Semicolon:=True, FieldInfo:=Array(Array(1, 9))
    End Sub
    Hope this helps, good luck.
    Peter
    Excel 365 - Windows 10
    - 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 # key in the Reply window
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

  5. #5
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    40,976
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    21 Thread(s)

    Default Re: Help with duplicate values move horizontally

    Just re-reading this thread and noticed that you originally asked for a formula to do this.
    If you are interested, that can be done & for this I have assumed a heading row with data starting in row 2.
    D2 is copied down as far as you might ever need.
    E2 is copied across as far as you might ever need and down as far as the column D formula.

    Summary

    ABCDEFGH
    1
    2204089954Z4 204089954Z4
    320378403185 2037840318544557860
    420378404455 203832831239999
    520378407860 203819014B3
    620383283123
    720383289999
    8203819014B3

    Spreadsheet Formulas
    CellFormula
    D2=IFERROR(INDEX($A$2:$A$8,MATCH(0,INDEX(COUNTIF($D$1:D1,$A$2:$A$8)+(A$2:A$8=""),0),0)),"")
    E2=IFERROR(INDEX($B$2:$B$8,AGGREGATE(15,6,(ROW($B$2:$B$8)-ROW($B$2)+1)/($A$2:$A$8=$D2),COLUMNS($E2:E2))),"")


    Excel tables to the web >> Excel Jeanie HTML 4
    Hope this helps, good luck.
    Peter
    Excel 365 - Windows 10
    - 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 # key in the Reply window
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

  6. #6
    New Member sakis_s's Avatar
    Join Date
    Sep 2019
    Location
    Greece
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Help with duplicate values move horizontally

    Quote Originally Posted by Peter_SSs View Post
    Just re-reading this thread and noticed that you originally asked for a formula to do this.
    If you are interested, that can be done & for this I have assumed a heading row with data starting in row 2.
    D2 is copied down as far as you might ever need.
    E2 is copied across as far as you might ever need and down as far as the column D formula.

    Summary

    A B C D E F G H
    1
    2 2040899 54Z4 2040899 54Z4
    3 2037840 3185 2037840 3185 4455 7860
    4 2037840 4455 2038328 3123 9999
    5 2037840 7860 2038190 14B3
    6 2038328 3123
    7 2038328 9999
    8 2038190 14B3

    Spreadsheet Formulas
    Cell Formula
    D2 =IFERROR(INDEX($A$2:$A$8,MATCH(0,INDEX(COUNTIF($D$1:D1,$A$2:$A$8)+(A$2:A$8=""),0),0)),"")
    E2 =IFERROR(INDEX($B$2:$B$8,AGGREGATE(15,6,(ROW($B$2:$B$8)-ROW($B$2)+1)/($A$2:$A$8=$D2),COLUMNS($E2:E2))),"")


    Excel tables to the web >> Excel Jeanie HTML 4
    That's an amazing solution as well! Thanks you so much for this function Peter! Script seems to work easier in my situation!

    By the way, is there any way to also make the exact opposite using a script?

  7. #7
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    40,976
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    21 Thread(s)

    Default Re: Help with duplicate values move horizontally

    Quote Originally Posted by sakis_s View Post
    Script seems to work easier in my situation!
    OK, so you have a couple of those to choose from.


    Quote Originally Posted by sakis_s View Post
    By the way, is there any way to also make the exact opposite using a script?
    Sure, if you started with the results above in columnd D, E, F, ... and columns A:C blank then try

    Code:
    Sub Make_List()
      Dim a As Variant, b As Variant
      Dim i As Long, j As Long, k As Long
      
      a = Range("D1").CurrentRegion.Value
      ReDim b(1 To UBound(a) * UBound(a, 2), 1 To 2)
      For i = 1 To UBound(a)
        For j = 2 To UBound(a, 2)
          If Len(a(i, j)) > 0 Then
            k = k + 1
            b(k, 1) = a(i, 1): b(k, 2) = a(i, j)
          End If
        Next j
      Next i
      Range("A1").Resize(k, 2).Value = b
    End Sub
    Hope this helps, good luck.
    Peter
    Excel 365 - Windows 10
    - 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 # key in the Reply window
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

  8. #8
    New Member sakis_s's Avatar
    Join Date
    Sep 2019
    Location
    Greece
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Help with duplicate values move horizontally

    Quote Originally Posted by Peter_SSs View Post
    OK, so you have a couple of those to choose from.


    Sure, if you started with the results above in columnd D, E, F, ... and columns A:C blank then try

    Code:
    Sub Make_List()
      Dim a As Variant, b As Variant
      Dim i As Long, j As Long, k As Long
      
      a = Range("D1").CurrentRegion.Value
      ReDim b(1 To UBound(a) * UBound(a, 2), 1 To 2)
      For i = 1 To UBound(a)
        For j = 2 To UBound(a, 2)
          If Len(a(i, j)) > 0 Then
            k = k + 1
            b(k, 1) = a(i, 1): b(k, 2) = a(i, j)
          End If
        Next j
      Next i
      Range("A1").Resize(k, 2).Value = b
    End Sub
    That works perfectly too!
    Thank you so much Peter!

    Just noticed one thing:
    Some cells are formatted as text and have leading zeros:
    e.g. "0700", "0010" etc.

    Macro when pastes to new cells, changes the format and i'm loosing the leading zeros. Do you know why is this happening?

  9. #9
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    40,976
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    21 Thread(s)

    Default Re: Help with duplicate values move horizontally

    Try making this change near the end of the macro
    Code:
    Range("A1").Resize(k, 2).Value = b
    With Range("A1").Resize(k, 2)
      .NumberFormat = "@"
      .Value = b
    End With
    Hope this helps, good luck.
    Peter
    Excel 365 - Windows 10
    - 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 # key in the Reply window
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

  10. #10
    New Member sakis_s's Avatar
    Join Date
    Sep 2019
    Location
    Greece
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Help with duplicate values move horizontally

    Quote Originally Posted by Peter_SSs View Post
    Another way that you could consider
    Code:
    Sub Rearrange()
      Dim d As Object
      Dim a As Variant
      Dim i As Long
      
      Set d = CreateObject("Scripting.Dictionary")
      a = Range("A1", Range("B" & Rows.Count).End(xlUp)).Value
      For i = 1 To UBound(a)
          d(a(i, 1)) = d(a(i, 1)) & ";" & a(i, 2)
      Next i
      Range("D1:E1").Resize(d.Count).Value = Application.Transpose(Array(d.Keys, d.Items))
      Range("E1").Resize(d.Count).TextToColumns DataType:=xlDelimited, Semicolon:=True, FieldInfo:=Array(Array(1, 9))
    End Sub
    Yes! Now copies values as text! Perfect! Can you help me with your previous script too? I really appreciate your help Peter!

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
  •