I have data in an Excel worksheet in a single column like the following:

  • [Name]
  • [Company]
  • [Name]
  • [Company]
  • [Phone]
  • [Name] ...

Most people don't have phone numbers included, but some do. Those that do have a phone number have a cell filled with the phone number after their email and before the column continues with the next person's name.

How could I convert this to standard data table with the following headers:

Name Company Email Phone

Here are some sample data you can use for testing:

john smith
Smith inc
John Doe
doe inc
jack spratt
spratt inc
bill fish
fish inc
+011 234 567
  • 1
    What is the format of phone number? Do company and email always exist? – Máté Juhász Jul 5 '19 at 19:07
  • Company and email always exist, phone numbers always start with "+" or a digit, i.e. ##########, ###-###-####, +# ### ### ####, +# ########## – Michael Jul 5 '19 at 19:16
  • Does a [Name] value  ever start with a "+" or a digit? – Scott Jul 6 '19 at 1:39

Here’s a solution without VBA.  (Spoiler alert: it’s not entirely complete, and it can be made complete with VBA.)

I assume:

  • Your existing data are in Column A, starting in cell A1, and
  • [Name] values never start with a "+" or a digit.

Let’s put the data into Columns M through P.

  • Enter the NameCompanyEmailPhone headings into cells M1 through P1.
  • In cell L2, enter 1 (the number one).
  • In cell K2, enter =IF(L2<=0, "", LEFT(INDEX(A:A, L2+3),1)).
  • In cell L3, enter =IF(K2="", 0, IF(OR(K2="+",AND(K2>="0",K2<="9")), L2+4, L2+3)).
  • In cell M2, enter =IF($L2=0, "", INDEX($A:$A, $L2)).
  • In cell N2, enter =IF($L2=0, "", INDEX($A:$A, $L2+1)).
  • In cell O2, enter =IF($L2=0, "", INDEX($A:$A, $L2+2)).
  • In cell P2, enter =IF(OR($L2=0,$L3=$L2+3,$L3=0), "", INDEX($A:$A, $L2+3)).
  • If you don’t know how many records you have, guesstimate. Take the number of rows of raw data (let’s call it M ) and divide by 3, rounding down.  Call this number N.  Since every record is at least 3 rows, there can be at most N / 3 records.
  • Select L3 and drag/fill down to row N+1.  (This gives us N rows, because we don’t have data in row 1.)
  • Select K2 and drag/fill down to row N+1.
  • Select M2:P2 and drag/fill down to row N+1.

You should have something like this:


If you had many four-row records (i.e., records with a phone number), then you may have several rows with zeroes below your data.  Display Blank when Referencing Blank Cell in Excel discusses some ways of suppressing those, but the smarter thing to do is to copy the valid data (cells M1:P5 in the above example) and paste values.

The email addresses will not be rendered as hyperlinks automatically.  If your database is not huge, you can use this manual method to turn them into hyperlinks:

  1. Click on the first one (cell O2).
  2. Press F2.  Press Enter.
  3. Repeat step 2 until you get to the end of the data.

If you don’t want to do that, you can use the techniques described in How to turn plain text links into hyperlinks in Excel? and How to turn hundreds of text URLs in Excel into clickable hyperlinks? (most of which involve VBA).


If you are open to a VBA solution, it is relatively straightforward, although the code is somewhat complex.

Algorithm depends on:

  • Phone being the only optional componenet
  • All components are in a fixed order
  • No empty rows

So we

  • loop through the data
  • always extract the first three as name, company, email
  • test the fourth line and see if it starts with a + or a digit
    • if it does, store it as the phone and the four as a line in the dictionary
    • if not store the previous three as a line in the dictionary

For convenience, intelligibility and speed - I created a class object to hold the data - I created a dictionary to hold the different class objects - I used regular expressions to decide if the optional phone number entry matched the pattern - I used VBA arrays rather than working directly on the worksheet as this is about 10x faster.

To enter this Macro (Sub), alt-F11 opens the Visual Basic Editor.

Ensure your project is highlighted in the Project Explorer window.

Then, from the top menu, select Insert/Module or Insert/Class Module and paste the appropriate code below into the window that opens.

Make the appropriate edits in the code if your worksheet names and desired ranges are not as you want. The code assumes your data source starts in A1 on Sheet1 and that the results will start on A1 on Sheet2

Be sure to set the appropriate references as mentioned in the comments at the top of the regular module Tools/References and select them

To use this Macro (Sub), opens the macro dialog box. Select the macro by name, and RUN.

Class Module

Option Explicit
Private pName As String
Private pCompany As String
Private pEmail As String
Private pPhone As Variant

Public Property Get Name() As String
    Name = pName
End Property
Public Property Let Name(Value As String)
    pName = Value
End Property

Public Property Get Company() As String
    Company = pCompany
End Property
Public Property Let Company(Value As String)
    pCompany = Value
End Property

Public Property Get Email() As String
    Email = pEmail
End Property
Public Property Let Email(Value As String)
    pEmail = Value
End Property

Public Property Get Phone() As Variant
    Phone = pPhone
End Property
Public Property Let Phone(Value As Variant)
    pPhone = Trim(CStr(Value))
End Property

Regular Module

'Set Reference to Microsoft Scripting Runtime
'set reference to Microsoft Regular Expressions 5.5
Option Explicit
Sub dataTable()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim cD As cData, dD As Dictionary
    Dim RE As RegExp
    Dim IDX As Long
    Dim I As Long, key As Variant

Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet2")
    Set rRes = wsRes.Cells(1, 1)

With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

Set dD = New Dictionary
Set RE = New RegExp
With RE
    .Pattern = "\s*[+\d]"
    .Global = False
End With

For I = 1 To UBound(vSrc, 1)
    If I = 1 Then
        Set cD = New cData
        IDX = 0
    End If
        With cD
            .Name = vSrc(I, 1)
            .Company = vSrc(I + 1, 1)
            .Email = vSrc(I + 2, 1)
            If I + 3 > UBound(vSrc, 1) Then Exit For
            If RE.Test(vSrc(I + 3, 1)) Then
                    .Phone = vSrc(I + 3, 1)
                    I = I + 3
                    I = I + 2
                End If
            IDX = IDX + 1
            dD.Add key:=IDX, Item:=cD
        End With
        Set cD = New cData
Next I

ReDim vRes(0 To dD.Count, 1 To 4)
    vRes(0, 1) = "Name"
    vRes(0, 2) = "Company"
    vRes(0, 3) = "Email"
    vRes(0, 4) = "Phone"

For Each key In dD.Keys
    With dD(key)
        vRes(key, 1) = .Name
        vRes(key, 2) = .Company
        vRes(key, 3) = .Email
        vRes(key, 4) = .Phone
    End With
Next key

Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
    .Columns(4).NumberFormat = "@"
    .Value = vRes

    'add the hyperlinks
    Dim c As Range
    For Each c In .Columns(3).Cells
        If InStr(c.Text, "@") > 0 Then
            c.Hyperlinks.Add c, c.Text
        End If
    Next c
    .Style = "Output"
End With

End Sub

Original Data

enter image description here

Processed Data

enter image description here

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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