Convert Second Column Data to Multiple Columns while retaining First Column as Reference

%3CLINGO-SUB%20id%3D%22lingo-sub-2982258%22%20slang%3D%22en-US%22%3ERe%3A%20Convert%20Second%20Column%20Data%20to%20Multiple%20Columns%20while%20retaining%20First%20Column%20as%20Reference%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2982258%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F1223131%22%20target%3D%22_blank%22%3E%40rbarden%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EHere%20is%20a%20macro%20you%20can%20run%3A%3C%2FP%3E%0A%3CPRE%20class%3D%22lia-code-sample%20language-visual-basic%22%3E%3CCODE%3ESub%20CombineColors()%0A%20%20%20%20Const%20NameCol%20%3D%203%0A%20%20%20%20Const%20FirstRow%20%3D%204%0A%20%20%20%20Dim%20CurRow%20As%20Long%0A%20%20%20%20Application.ScreenUpdating%20%3D%20False%0A%20%20%20%20CurRow%20%3D%20FirstRow%0A%20%20%20%20Do%20While%20Cells(CurRow%2C%20NameCol%20%2B%201).Value%20%26lt%3B%26gt%3B%20%22%22%0A%20%20%20%20%20%20%20%20Do%20While%20Cells(CurRow%20%2B%201%2C%20NameCol).Value%20%3D%20%22%22%20And%20Cells(CurRow%20%2B%201%2C%20NameCol%20%2B%201).Value%20%26lt%3B%26gt%3B%20%22%22%0A%20%20%20%20%20%20%20%20%20%20%20%20Cells(CurRow%2C%20NameCol%20%2B%201).Value%20%3D%20Cells(CurRow%2C%20NameCol%20%2B%201).Value%20%26amp%3B%20%22%2C%20%22%20%26amp%3B%20Cells(CurRow%20%2B%201%2C%20NameCol%20%2B%201).Value%0A%20%20%20%20%20%20%20%20%20%20%20%20Cells(CurRow%20%2B%201%2C%20NameCol).Resize(1%2C%202).Delete%20Shift%3A%3DxlShiftUp%0A%20%20%20%20%20%20%20%20Loop%0A%20%20%20%20%20%20%20%20CurRow%20%3D%20CurRow%20%2B%201%0A%20%20%20%20Loop%0A%20%20%20%20Cells(1%2C%20NameCol%20%2B%201).EntireColumn.AutoFit%0A%20%20%20%20Application.ScreenUpdating%20%3D%20True%0AEnd%20Sub%0A%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2981972%22%20slang%3D%22en-US%22%3EConvert%20Second%20Column%20Data%20to%20Multiple%20Columns%20while%20retaining%20First%20Column%20as%20Reference%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2981972%22%20slang%3D%22en-US%22%3E%3CP%3EI%20have%20a%20situation%20where%20I%20have%20two%20columns%20of%20data%20that%20I%20need%20to%20convert%20the%20second%20column%20into%20multiple%20columns%20while%20retaining%20the%20first%20column%20as%20the%20reference%20column.%26nbsp%3B%20%26nbsp%3BThe%20second%20column%20can%20have%20a%20variable%20number%20of%20text%20entries%2C%20depending%20on%20the%20first%20column%20(not%20a%20fixed%20number%20of%20entries%20in%20the%20second%20column).%26nbsp%3B%20%26nbsp%3BThe%20objective%20is%20to%20get%20the%20second%20column%20into%20one%20text%20cell.%26nbsp%3B%20I%20can%20do%20that%20using%20concatenate%20or%20textjoin%2C%20so%20that%20isn't%20an%20issue.%26nbsp%3B%20Any%20help%20would%20be%20appreciated!%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EUpdated%3A%26nbsp%3B%20Rev%202.0%20has%20the%20correct%20reference%20to%20avoid%20confusion.%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-2981972%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EFormulas%20and%20Functions%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E
New Contributor

I have a situation where I have two columns of data that I need to convert the second column into multiple columns while retaining the first column as the reference column.   The second column can have a variable number of text entries, depending on the first column (not a fixed number of entries in the second column).   The objective is to get the second column into one text cell.  I can do that using concatenate or textjoin, so that isn't an issue.  Any help would be appreciated!

 

Updated:  Rev 2.0 has the correct reference to avoid confusion. 

2 Replies

@rbarden 

Here is a macro you can run:

Sub CombineColors()
    Const NameCol = 3
    Const FirstRow = 4
    Dim CurRow As Long
    Application.ScreenUpdating = False
    CurRow = FirstRow
    Do While Cells(CurRow, NameCol + 1).Value <> ""
        Do While Cells(CurRow + 1, NameCol).Value = "" And Cells(CurRow + 1, NameCol + 1).Value <> ""
            Cells(CurRow, NameCol + 1).Value = Cells(CurRow, NameCol + 1).Value & ", " & Cells(CurRow + 1, NameCol + 1).Value
            Cells(CurRow + 1, NameCol).Resize(1, 2).Delete Shift:=xlShiftUp
        Loop
        CurRow = CurRow + 1
    Loop
    Cells(1, NameCol + 1).EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

@Hans Vogelaar 

 

Thanks for this!   It works great without the intermediate steps.   I need to learn more about Macros, but your assistance was immensely helpful!