I have data in Excel that looks like this:

column1 column2 column3, column4, column5
Company1 email1 email2 email3
Company2 email1 email2
Company3 email1 email2 email3 email4 email5

I have about 25k rows of this data some maybe 25k companies and 40k email addresses. I'd like to make the data look like this:

Company1 email1
Company1 email2
Company1 email3
Company2 email1

Save the file csv and then use awk (linux or cygwin tool):

awk -F, '{if (NR>1) {if (NF==1) {print $1} else {for (f=2; f<=NF; f++) print $1","$f}}}' ./myfile.csv >./mynewfile.csv


awk reads in the file line by line, it splits up each line into 'fields' (i.e. columns) using the comma as delimiter (-F,), each field is called $1 up. It skips the first line (headers), then for each line it creates a series of lines where each field is on a separate line preceded by the first field. The output is written back to a new file. You can open this new file in Excel.

|improve this answer|||||
  • I like this nice and simple answer, but it could use a little more explanation. E.g. how does it work. – Hennes Dec 4 '15 at 9:25
  • @Hennes explanation added – gogoud Dec 4 '15 at 10:31
  • Yay. Cannot upvote twice though. – Hennes Dec 4 '15 at 10:34
  • ...but I can! :) BTW it will skip lines with less then 2 fields. So they will disappears all the lines with only the company and without email... Even if the OP didn't say it explicit usually are info you want to keep... – Hastur Dec 4 '15 at 10:43
  • @Hastur, edited to work right with lines with only 1 field – gogoud Dec 4 '15 at 10:54

This macro will do the work:

Public Sub createrows()
    Application.ScreenUpdating = False
    Dim wks As Worksheet
    Set wks = ActiveSheet
    firstrow = 2
    thecolumn = 3
    searchingrow = True
    therow = firstrow
    While searchingrow
        totalcolumns = wks.Cells(therow, Columns.Count).End(xlToLeft).Column
        For j = totalcolumns To thecolumn Step -1
            a = wks.Cells(therow, j)
            Rows(therow + 1).Insert shift:=xlShiftDown
            wks.Cells(therow + 1, 1) = wks.Cells(therow, 1)
            wks.Cells(therow + 1, 2) = wks.Cells(therow, j)
        Next j
        therow = therow + 1
        If wks.Cells(therow, 1) = "" Then searchingrow = False
    wks.Range(Cells(1, thecolumn), Cells(therow, 1000)).Delete
    Application.ScreenUpdating = True
    themessage = MsgBox("Finished", vbInformation)
End Sub

Open VBA/Macro with ALT+F11, insert a new module under ThisWorkbook and paste the code on the right side. Execute the Macro.

|improve this answer|||||

You can't do this directly in Excel. Your best option is to have a small program/script do the conversion for you. I propose to you an answer which uses Python.

  1. Download and install python if you don't have it installed on your computer already.

    Python Release Python 2.7.10 | Python.org (Direct link)

  2. From Excel, save your file as CSV.
    NB: There may be more than one CSV option in the Save-As dialogue box. Make sure to choose CSV (Comma delimited).
  3. Copy the code below into notepad and save it as convert.py. You will have to choose All Files in order for Notepad to save with the correct file extension.
    Remember to replace the "c:/users/user/desktop/book1.csv" and "c:/users/user/desktop/book2.csv" with the correct input and output file names respectively. Additionally, you should change all backslashes (\) with forward slashes (/).
infile = open("c:/users/user/desktop/book1.csv", "rb")
outfile = open("c:/users/user/desktop/book2.csv", "wb")
import csv
reader = csv.reader(infile)
writer = csv.writer(outfile)
reader.next() # skip header
writer.writerow(["Company", "Email"])
writer.writerows(((row[0], email) for row in reader \
                                  for email in row[1:] if email != ""))
  1. Double-click on the python file to run it and perform the conversion.
|improve this answer|||||
  • 1
    "You can't do this directly in Excel" - Excel comes with VBA you know. – Dmitry Grigoryev Dec 4 '15 at 10:50
  • @DmitryGrigoryev: I know that Excel comes with VBA and I use it regularly. What I was referring to is that no standard function in Excel allows you to do that sort of thing. As you can see, an answer has been provided that achieves the objective using a macro. I only used Python in my answer because of Python's simplicity as compared to VBA. – Alex Essilfie Dec 4 '15 at 15:49

Here is another VBA macro that should execute relatively quickly, as it does the work in VBA arrays, rather than on the worksheet.

It assumes the source data starts in A1 or A2; the data region is contiguous, and the emails for each company are contiguous (so that the first blank cell in a row is after the last email address). The code would require minor modifications if any of those assumptions are not true.

There is also an assumption that there are no column labels, with instructions in the code comments as to how to compensate for that.

Option Explicit
Sub RowsToColumns()
    Dim vSrc As Variant
    Dim COL As Collection
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim S(0 To 1) As String
    Dim I As Long, J As Long

'Define source and result worksheets and ranges
'Alter as necessary
Set wsSrc = Worksheets("sheet3")
Set wsRes = Worksheets("sheet4")
    Set rRes = wsRes.Cells(1, 1)

'Read source data into array
' This method assumes data starts in A2, and is
'  contained in a contiguous array.
'But other methods could be used
vSrc = wsSrc.Cells(2, 1).CurrentRegion

'Collect the results into Collection object
'Assumes no header row, if there is, then start
'  with for I = 2 to ...
Set COL = New Collection
For I = 1 To UBound(vSrc, 1) 'the rows
    For J = 2 To UBound(vSrc, 2) 'the columns
        S(0) = vSrc(I, 1) 'company name
        S(1) = vSrc(I, J) 'email
        If S(1) <> "" Then
            COL.Add S
            Exit For 'assumes first blank in email list is end of list
        End If
    Next J
Next I

'Create results array
ReDim vres(1 To COL.Count, 1 To 2)
For I = 1 To COL.Count
    With COL(I)
        vres(I, 1) = COL(I)(0)
        vres(I, 2) = COL(I)(1)
    End With
Next I

'Write the results to worksheet
Set rRes = rRes.Resize(rowsize:=UBound(vres, 1), columnsize:=UBound(vres, 2))
With rRes
    .Value = vres
End With

End Sub

|improve this answer|||||

Not the answer you're looking for? Browse other questions tagged or ask your own question.