Contact list from Vertical to Horizontal so it can be imported to datebase software

[BRIXTON]

I have a list of 40k contacts listed vertically that I would like to convert to a horizontal list, so that I can then import it to database software. Problem is that not each contact has the same info. i.e some have phone numbers, some have titles, some have addresses, and some don't. See table below. I added and labeled columns A & B in the thought that I could use those numbers and labels as a reference to pull into columns J through P but came to a dead end. Would very much appreciate some guidance as this list is much too long to do manually. Also, FYI, I know very little VB so if that's the best solution, I would appreciate it if you could put in laymen's terms to the extent that it is possible...

	A	b	c	d	e	f	g	h	i	j	k	l	m	n
1	1	name
2	2	title
3	3	company
4	4	address
5	5	suite
6	6	city/state
7	7	Phone				Desired Result:
8
9	1	John Smith					Name	Title	Company	Address	Suite	City/State	Phone
10	2	SVP					John Smith	SVP	Widget Manufacturing Co	123 Main Street		Los Angeles, CA	(555) 555-5555
11	3	Widget manufacturing Co
12	4	123 Main Street
13	6	Los Angeles, CA
14	7	(555) 555-5555
15
16
17
18
19
20
21
22
23
24
25
26
27

<tbody>
</tbody>

 

[Comfy]

Just to clarify something. You say that not each contact has the same info.

Does each contact still consist of seven rows? would there be blank values for the missing info or would the contact consist of less than seven rows?

 

[murphm03]

Copy the column,then click on a free cell that suits-go to paste special and tick transpose in the pop up (bottom right) and ok.There your done

 

[Comfy]

Copy the column,then click on a free cell that suits-go to paste special and tick transpose in the pop up (bottom right) and ok.There your done

For multiple records Transpose would just paste all values in the same row.
I think the OP wishes each record to be on its own row.

 

[Comfy]

You could try the following:

Sub ContactExtract()
Dim Contacts As Range
Dim i As Long, j As Long, Records As Long


Set Contacts = Selection
Records = 2


For i = 1 To Contacts.Cells.count Step 7
    For j = 1 To 6
        Sheets(2).Cells(Records, j).Value = Sheets(1).Cells(i + j - 1, 1).Value
    Next j
Records = Records + 1
Next i


End Sub

But I imagine like anything more info is required to tailor this to your needs.

Excel 2010

	A
1	John Smith
2	SVP
3	Widget manufacturing Co
4	123 Main Street
5	Los Angeles, CA
6	(555) 555-5555
7
8	John Smith
9
10	Widget manufacturing Co
11	123 Main Street
12	Los Angeles, CA
13	(555) 555-5555
14
15	John Smith
16	SVP
17
18	123 Main Street
19	Los Angeles, CA
20	(555) 555-5555
21
22	John Smith
23	SVP
24	Widget manufacturing Co
25
26	Los Angeles, CA
27	(555) 555-5555
28
29	John Smith
30	SVP
31	Widget manufacturing Co
32	123 Main Street
33
34	(555) 555-5555
35
36	John Smith
37	SVP
38	Widget manufacturing Co
39	123 Main Street
40	Los Angeles, CA

<colgroup><col style="width: 25pxpx"><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

Becomes:

Excel 2010
	A	B	C	D	E	F
1	Name	Title	Company	Address 1	Address 2	Phone Number
2	John Smith	SVP	Widget manufacturing Co	123 Main Street	Los Angeles, CA	(555) 555-5555
3	John Smith		Widget manufacturing Co	123 Main Street	Los Angeles, CA	(555) 555-5555
4	John Smith	SVP		123 Main Street	Los Angeles, CA	(555) 555-5555
5	John Smith	SVP	Widget manufacturing Co		Los Angeles, CA	(555) 555-5555
6	John Smith	SVP	Widget manufacturing Co	123 Main Street		(555) 555-5555
7	John Smith	SVP	Widget manufacturing Co	123 Main Street	Los Angeles, CA
Sheet2

 

[TheVillageIdiot]

VBA would be your best bet. I don't think you can transpose data easily using native Excel functionality and a formula solution would likely take forever to calculate.

Run the following code on a sample set of a copy of your data and report your results. You should have the data sheet active when you run it, as I only specified the data on the active sheet in the code.

Sub TransformData()
Dim xlApp As Excel.Application
Dim wkbk As Workbook, wks As Worksheet, NewWks As Worksheet
Dim i As Long, LR As Long, NR As Long, arr(1 To 7) As Long, arrData, SzArr As Long

Set xlApp = Excel.Application

With xlApp
    .ScreenUpdating = False
    .DisplayAlerts = False
    .StatusBar = False
End With

Set wkbk = ThisWorkbook
With wkbk
    Set wks = .ActiveSheet
    Set NewWks = .Worksheets.Add
    With NewWks
        .Cells(1, 1) = "ItemID"
        .Cells(1, 2) = "DataValue"
    End With
End With
    
    SzArr = UBound(arr) - LBound(arr) + 1
    For i = LBound(arr) To UBound(arr)
        arr(i) = i
    Next i
    
    With wks
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To LR  '' Change this to the row which starts the data table.  I assumed a header row
            xlApp.StatusBar = i & " of " & LR
            arrData = xlApp.Transpose(xlApp.Transpose(.Range(.Cells(i, 1), .Cells(i, SzArr)).Value))
            With NewWks
                NR = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                .Cells(NR, 1).Resize(SzArr) = xlApp.Transpose(arr)
                .Cells(NR, 2).Resize(SzArr) = xlApp.Transpose(arrData)
            End With
        Next i
        
    End With

Erase arr
Erase arrData

With xlApp
    .ScreenUpdating = True
    .DisplayAlerts = True
    .StatusBar = False
End With

End Sub

 

[TheVillageIdiot]

My solution does the opposite of what you intended -- it takes a flat file format and puts it into a vertical database format.

 

[BRIXTON]

Each contact has a different amount of rows (7 or less).

Just to clarify something. You say that not each contact has the same info.

Does each contact still consist of seven rows? would there be blank values for the missing info or would the contact consist of less than seven rows?

 

[BRIXTON]

Would you mind explaining how I run this? Not sure how to see if your solution works