Results 1 to 8 of 8
  1. #1
    New Lounger
    Join Date
    Oct 2016
    Posts
    3
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Post Transferring duplicate data from multiple rows into a single row - Pls Help

    Dear all



    Please I need a formula or macro to transfer duplicate data in multiple rows into a single row. please see Example of what i want below.

    Please see attached.

    The data is in sheet one the output I want is in sheet 2.


    Attached Files Attached Files

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,638
    Thanks
    115
    Thanked 650 Times in 592 Posts

    Using a dictionary

    Stefann,

    Here is some code the will do what you described. It uses a dictionary to test if the connection name is a duplicate or not. If it is a duplicate, then the record will be copied to the same row, next column block. If the connection name is unique, then the record will be copied to a new row starting in the first column block.

    HTH,
    Maud

    Code:
    Public Sub TransferData()
    Application.ScreenUpdating = False
    '----------------------------------
    'DECLARE AND SET VARIABLES
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim cell As Range, rng As Range, dnary As Object
    Dim row As Long, col As Long, I As Long, LastRow As Long
    Set dnary = CreateObject("Scripting.Dictionary")
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    LastRow = ws1.Cells(Rows.Count, 3).End(xlUp).row
    Set rng = ws1.Range("C2:C" & LastRow)
    col = 1
    row = 2
    Index = 1
    '----------------------------------
    'CYCLE THROUGH CONNECTION NAMES - TEST IF DUPLICATE
    For Each cell In rng
        If dnary.Exists(cell.Value) Then 'DUPLICATE- KEEP ROW
            col = col + 10
         Else:  'UNIQUE- NEW ROW
            dnary.Add cell.Value, Index
            Index = Index + 1
            col = 1
            row = row + 1
        End If
    '----------------------------------
    'TRANSFER DATA
        ws2.Cells(row, col) = cell
        For I = 1 To 9
            ws2.Cells(row, col + I) = cell.Offset(0, I)
        Next I
    Next cell
    '----------------------------------
    'CLEANUP
    Set dnary = Nothing
    Application.ScreenUpdating = True
    End Sub
    Last edited by Maudibe; 2016-11-06 at 19:39. Reason: correct spelling

  3. #3
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,191
    Thanks
    48
    Thanked 985 Times in 915 Posts
    Maude, wouldn't you read all values into the dictionary, sort then read the dictionary out to the new sheet with duplicates offset? Doing it this way seems to place the duplicates in a new row with column offset - or am I just reading it wrong?

    cheers, Paul

  4. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,638
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Hi Paul,

    Great question! You are correct in that a dictionary could be used for the purposes that you state. In this instance however, I am using a dictionary to add connection names one at a time to test for duplicates. Since the dictionary has a method to check for an existing member (.exists), unique connections names can be added if .exists= False while duplicate connection names will return True (.exists= True). The dictionary here is not used to return data.

    The code tests for the returned Boolean value (see code highlighted blue). If dnary.exists is False then I know that it is a unque value and it is added to the dictionary as well as added to a new line on the spreadsheet. If dnary.exists is true, then it is a duplicate connection and the record gets placed on the same line but next column block over.

    Code:
    If dnary.Exists(cell.Value) Then   'TRUE - DUPLICATE- KEEP ROW
            col = col + 10  'SET COLUMN TO NEXT BLOCK
         Else:  'FALSE - UNIQUE- NEW ROW
            dnary.Add cell.Value, Index  'UNIQUE CONNECTION NAME ADDED TO DICTIONARY
            Index = Index + 1
            col = 1
            row = row + 1
    '.....
    Using a loop, the .offset is used to copy the rest of the record data from the right of the connection name on sheet 1 to the new sheet 2 to the right of the connection name in the appropriate column block. The image is difficult to see but the output shows records with the same connection name are on the same row.

    dnary1.png

  5. #5
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,191
    Thanks
    48
    Thanked 985 Times in 915 Posts
    I just can't see how it knows what row to place duplicates.
    e.g. A new value always exists in the first entry so row = 1
    The tenth value is a duplicate of the first, so you keep the row, which now equals 10 and offset the column.

    cheers, Paul

  6. #6
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,638
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Hay Paul,

    Let's walk through it.

    The code sets the initial col to 1 and row to 2:
    col = 1
    row = 2

    The code then cycles through the connection names (cell) down column A (rng)
    For Each cell In rng

    Now for the IF test. The connection name (cell) is compared to the values in the dnary dictionary
    If dnary.Exists(cell.Value)

    If it does not match, it is unique and it performs the Else (false) part of the IF test.
    1. Adds it to the dnary dictionary for future comparisons: dnary.Add cell.Value, Index
    2. Increments the row to place it on a new line: row = row + 1

    If it does match then then it performs the true part of the if test:
    1. Advance col to the col number of the next block to the right but does not increment the row.
    col = col + 10

    Therefore, a duplicate connection name is written to the same row.

    Code:
    For Each cell In rng
        If dnary.Exists(cell.Value) Then 'DUPLICATE- KEEP ROW
            col = col + 10
         Else:  'UNIQUE- NEW ROW
            dnary.Add cell.Value, Index
            Index = Index + 1
            col = 1
            row = row + 1
        End If
    Using Dictionaries are an excellent way to find duplicates for values without having to write them to a sheet. The .exists method makes this possible whereas using a Collection instead, does not have this method.

    Hope that explains it a little bit better.

    Maud

  7. #7
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,191
    Thanks
    48
    Thanked 985 Times in 915 Posts
    I can see it working if the duplicates are already grouped, but not if you have gaps.

    cheers, Paul

  8. #8
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,638
    Thanks
    115
    Thanked 650 Times in 592 Posts
    I see where you are coming from. Yes, the connection names would have to be sorted. I was under the assumption from the sample data that they were.

    Maud

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •