Converting list of contact details in single column to rows format

[pjm]

Hello,

I have a database of contacts (2000+) which are entered in column format as under:

<table style="border-collapse: collapse; width: 360pt;" border="0" cellpadding="0" cellspacing="0" width="479"><col style="width: 244pt;" width="325"> <col style="width: 116pt;" width="154"> <tbody><tr style="height: 15pt;" height="20"> <td class="xl66" style="height: 15pt; width: 244pt;" width="325" height="20">Address</td> <td style="width: 116pt;" width="154">Main Road</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">City</td> <td>Chennai</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Company Name</td> <td>New India Industries</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Contact Person</td> <td>Mr. Ramesh</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">E-Mail</td> <td class="xl67">ramesh482@gmail.com</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Telephone</td> <td align="right">583205923</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">
</td> <td>
</td> </tr> <tr style="height: 30pt;" height="40"> <td class="xl66" style="height: 30pt; width: 244pt;" width="325" height="40">Address</td> <td>M G Road</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">City</td> <td>Hyderabad</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Company Name</td> <td>Senthil Enterprise</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Fax</td> <td>Mr. Senthil</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Products</td> <td>Chemicals</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">
</td> <td class="xl67">
</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl66" style="height: 15pt; width: 244pt;" width="325" height="20">Address</td> <td>Kalka Cross Roads</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">City</td> <td>Delhi</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Company Name</td> <td>Jagtar Enterprises</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Contact Person</td> <td>Mr. Singh</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">MFG / Service</td> <td>Automobile Products</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Telephone</td> <td align="right">79104923</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">
</td> <td>
</td> </tr> <tr style="height: 30pt;" height="40"> <td class="xl66" style="height: 30pt; width: 244pt;" width="325" height="40">Address</td> <td>Rogerie Complex - 2</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">City</td> <td>Mumbai</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Company Name</td> <td>Alang Enterprises</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Contact Person</td> <td>Ms. Debby</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">E-Mail</td> <td class="xl67">alantent@gmail.com</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Fax</td> <td align="right">202935929</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Products</td> <td>Wood Products</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 244pt;" width="325" height="20">Telephone</td> <td align="right">59291502</td> </tr> </tbody></table>

The problem with above data is that the contents of each contact details are not uniform as some doesn't have email, some doesn't have product details. Each contact is separated by a blank line

What I am looking at is to have these 2000 odd contact details in proper row format as under

Contact Person, Company Name, Address, City, Telephone, Fax, Email, Prodcuts.

For records which doesn't have data, it can show as blank.

Request for a solution to such a problem

Regards

Paresh

 

[rbrhodes]

Hi

Every record starts with address?

 

[pjm]

Hi,

Yes, every record starts with Address

Thanks for your prompt response.

Regards

Paresh

 

[rbrhodes]

Hi 2nd question:

Is MFG / Service the same as Products?

Are there any other categories that don't match?

I guess you could have a column of 'unmatched' that you could do manually...

 

[pjm]

Hi,

Yes, MFG... is same as Products - same field. I will have it updated to a unique name.

Sorry for that,

Regards

Paresh

 

[rbrhodes]

Hi,

There are some other errors as well but they could be dealt with. Ie Fax <> "Mr. Senthil" I'm sure...

As there's no way for me to attach a file here click on my sig, send me an email and I'll send you an example sheet.

Here's some example code:

It has no error handling, simply dumps whatevers there to whereever it's told to put it. Any thing it doesn't get is put in 'misc column'.

Option Explicit

Sub Xfer()

'
'//Presumes a blank row means a new set of records
'  Source data is in A & B, headers are as on sheet 2
'  eg (As in Select Case)

'Objects, etc
Dim cel As Range
Dim rng As Range
Dim DestRow As Long
Dim LastRow As Long
Dim wsDst As Worksheet
Dim wsSrc As Worksheet

'//Change sheet names to suit
    Set wsDst = Sheets("Sheet2")
    Set wsSrc = Sheets("Sheet1")

    'First row to put stuff
    DestRow = 2
'//End change

    
    With wsSrc
        'Get last row of data
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        'Where to look
        Set rng = .Range("A1:A" & LastRow)
    End With
    
    With wsDst
        'Do all
        For Each cel In rng
            If cel <> "" Then
                'Choose header
                Select Case UCase(cel)
                    Case Is = "CONTACT PERSON"
                        cel.Offset(0, 1).Copy .Cells(DestRow, "A")
                    Case Is = "COMPANY NAME"
                        cel.Offset(0, 1).Copy .Cells(DestRow, "B")
                    Case Is = "ADDRESS"
                        cel.Offset(0, 1).Copy .Cells(DestRow, "C")
                    Case Is = "CITY"
                        cel.Offset(0, 1).Copy .Cells(DestRow, "D")
                    Case Is = "TELEPHONE"
                        cel.Offset(0, 1).Copy .Cells(DestRow, "E")
                    Case Is = "FAX", "FACSIMILE"
                        cel.Offset(0, 1).Copy .Cells(DestRow, "F")
                    Case Is = "E-MAIL", "EMAIL", "E MAIL"
                        cel.Offset(0, 1).Copy .Cells(DestRow, "G")
                    Case Is = "PRODUCTS", "MFG / SERVICE"
                        cel.Offset(0, 1).Copy .Cells(DestRow, "H")
                    Case Else
                        cel.Offset(0, 1).Copy .Cells(DestRow, "I")
                End Select
            Else
                'Blank = start new dest row
                DestRow = DestRow + 1
            End If
        Next cel
    End With


    'Cleanup
    Set cel = Nothing
    Set rng = Nothing
    Set wsDst = Nothing
    Set wsSrc = Nothing

End Sub