# One column data into database table format

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
Smith@example.org
John Doe
doe inc
doe@example.com
123-456-789
jack spratt
spratt inc
sprat@example.net
456789
bill fish
fish inc
fish@example.com
+011 234 567
``````
• 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

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

• Enter the `Name``Company``Email``Phone` 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
Else
I = I + 2
End If
IDX = IDX + 1
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
.EntireColumn.Clear
.Columns(4).NumberFormat = "@"
.Value = vRes

Dim c As Range
For Each c In .Columns(3).Cells
If InStr(c.Text, "@") > 0 Then
End If
Next c
.Style = "Output"
.EntireColumn.AutoFit
End With

End Sub
``````

Original Data Processed Data 