1

I have a two column list of key-value pairs. For example:

71  Archaebacteria
71  Mendosicutes
71  Metabacteria
72  blue green algae
72  blue-green algae
72  Cyanochloronta
72  Cyanophyta
73  CFB group
73  Chloroflecales
73  Chloroflexaceae/Deinococcaceae group
73  Chloroflexus/Deinococcaceae group
73  Chloroflexus/Deinococcus group
73  Cytophaga-Flexibacter-Bacteroides group
73  Fibrobacter-Acidobacteria group
73  Flexistipes group
73  GNS bacteria
73  Green non-sulfur bacteria
73  true bacteria

I need to 'flatten' the two column list into an array where the key remains in column 1 and all values for the key are moved to new cells on the same row.

Some keys have 20 values. For that case, there would be 21 columns (1 for the key, 20 for the key's values).

I have studied this question but have not been able to successfully modify it to produce the desired results.

How to transform an Excel list into an array?

Notes: a solution may leave a value in column 2 and 'copy' that value to the appropriate row in the array. Alternatively, a solution may 'move' the value to the proper position in the array, leaving a key with a NULL value. These "clean-up" conditions are OK as I'll sort/delete to remove detritus from the new array.

Either a formula or VBA solution is good.

Improve this question
3
  • 1
    Have you tried pivot tables? They do exactly what you need. Commented Feb 27, 2017 at 11:28
  • I did but failed (or did not do it properly). I also tried COPY/PASTE/TRANSFORM - which produces the correct result but must be done manually for each key. Would you point me to a pivot table example that I can appy and test? Commented Feb 27, 2017 at 11:34
  • Use a Dictionary, there are plenty of similar examples right here on SO Commented Feb 27, 2017 at 11:50

1 Answer 1

Reset to default
1

The code below uses Dictionary to organize all unique keys (71, 72, 73) and their values from Column A:B.

Afterwards it pastes the values to Columns C:D.

Code

Option Explicit

Sub TestDict()

Dim Dic As Object
Dim C As Range, C2 As Range, lRow As Long
Dim Names As String, ID$, Key As Variant, KeyVal As Variant, IDVal As Variant

Set Dic = CreateObject("Scripting.Dictionary")

With Sheets("Sheet2") '<-- modify "Sheet2" with your sheet's name
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    For Each C In .Range("A1:A" & lRow).Cells
        If Not Dic.exists(CStr(C.Value)) Then
            ID = C.Value

            For Each C2 In .Range("A1:A" & lRow).Cells
                If C2.Value = ID Then
                    If Names = "" Then ' first key value
                        Names = C2.Offset(, 1).Value
                    Else  ' second and up key value
                        Names = Names & "," & C2.Offset(, 1).Value
                    End If
                End If
            Next C2
            Dic.Add ID, Names
        End If

        ID = Empty: Names = Empty
    Next C
End With

lRow = 1
With Sheets("Sheet2") ' <-- paste the organized dictionary key anv values the columns C:D
    For Each Key In Dic.Keys
        .Range("C" & lRow).Value = Key

        ' splitting values from "Merged" string Key to array
        KeyVal = Split(Dic(Key), ",")
        .Range("D" & lRow).Resize(1, UBound(KeyVal) + 1).Value = KeyVal
        lRow = lRow + 1
    Next Key
End With

End Sub

> Blockquote
Improve this answer
Sign up to request clarification or add additional context in comments.

4 Comments

Thank you for the inline explanations.
@JayGray you're welcome :) You should take the time to learn how to use the Dictionary, it's a handy and powerful tool
Until now I knew nothing about Dictionary, so thank you again @Shai Rado
Thank you again @Shai Rado - this is a life saver.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.