I should have mentioned that this code will work when there are any number of
emails for a company, from 1 to lots, as long as the list is sorted by
company name.

"JLatham" wrote:

And here is a solution that will move emails from same named companies and
eventually delete the rows with the entries where emails were copied up. The
list does need to be sorted by the company name.

To use the code: Make a copy of your workbook to use just in case this
turns out not to work out the way you want. Open that copy.
Press [Alt]+[F11] to open the Visual Basic editor (VBE). In the VBE use
it's menu to Insert | Module.
Copy the code below and paste it into the empty module presented to you.
Close the VB Editor.
Choose the sheet with the company/email lists on it.
From the Excel Menu choose: Tools | Macro | Macros and highlight the entry
for ReorganizeEmails and click the [Run] button.

It should work very quickly for you. If things look alright to you, you can
save the workbook over the original, or just keep the old one for a backup
copy.

Sub ReorganizeEmails()
'the sheet with the lists must
'be selected when you run this
Dim lastRow As Long
Dim columnOffset As Integer
Dim currentCompany As String
Dim outerLoop As Long
Dim innerLoop As Long

lastRow = ActiveSheet.Range("A" & _
Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For outerLoop = 1 To lastRow - 1
If Not IsEmpty(Range("A" & outerLoop)) And _
UCase(Trim(Range("A" & outerLoop))) < _
currentCompany Then
currentCompany = _
UCase(Trim(Range("A" & outerLoop)))
columnOffset = 2
For innerLoop = outerLoop + 1 To lastRow
If UCase(Trim(Range("A" & innerLoop))) = _
currentCompany Then
Range("A" & outerLoop).Offset(0, columnOffset) = _
Range("A" & innerLoop).Offset(0, 1)
columnOffset = columnOffset + 1
'erase company name so we
'can delete the rows later
Range("A" & innerLoop) = ""
Else
'new company name
Exit For
End If
Next ' innerLoop
End If
Next ' outerLoop
'erase the entries we copied
'the emails from
For outerLoop = lastRow To 1 Step -1
If IsEmpty(Range("A" & outerLoop)) Then
Range("A" & outerLoop).EntireRow.Delete
End If
If ActiveCell.Row = 1 Then
Exit For
End If
Next
End Sub

"cyb3rwolf" wrote:

forgive me, not that experienced with exel. I am using exel 2007. I have a
spread sheet that lists off names of companies and lists e-mail contacts for
that company. Column A lists the different companies, and column B lists the
e-mail addresses. All companies have at least 2 e-mail contacts, so columna
will have the same company name repeated for howmany e-mail contacts there
are for that company in column b. What i need to do is only have one line
for each company, with each of the columns after that having the different
e-mail addresses. (Column A would be the company, column b would be the first
e-mail contact, column c would be the second e-mail contact, etc.). Anybody
help me out in an easy way to accomplish this? It is a very large spread
sheet.