Converting multiple rows into columns

[Jack]

I am working on a list of contacts that is listed by rows and columns in the
following manner:

Column A Coilumn B

ABC Inc
Address: Primary Contact:
1 Main Street John Doe
Mainvile CT 06405 Business Type:
Contractor/SubContractor
Phone: 203-555-0000
Fax: 203-555-0001
Email: (e-mail address removed)

I need to convert the data into columns to import into my ACT database. CAn
anyone help??? Thanks in advance...

Jack

 

[Joel]

This code may work. Thsi type of data is not formatted very well and there
may be some problems. Some lines have the category and data on the same line
others don't. Some like address have multiple lines. With only one company
as a sample it is hard to write code that is going to work for every case. I
took my best guess at trying to make this code work in the general case for
every company.


The code looks for the input data on Sheet 1 and expects a blank worksheet
called data.


Sub make_DB()

Sh2RowCount = 2
StartRow = 1
StartAccnt = True


With Sheets("data")
.Cells(1, "A") = "Company"
.Cells(1, "B") = "Address"
.Cells(1, "C") = "Phone"
.Cells(1, "D") = "Fax"
.Cells(1, "E") = "Email"
.Cells(1, "F") = "Business Type"
.Cells(1, "G") = "Primary Contact"
End With

With Sheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For Sh1RowCount = 1 To (LastRow + 1)
If .Cells(Sh1RowCount, "A") <> "" Then
If StartAccnt = True Then
StartRow = Sh1RowCount
StartAccnt = False
End If
Else
If StartAccnt = False Then
Call GetData(StartRow, Sh1RowCount - 1, _
Sh2RowCount)
End If
StartAccnt = True
Sh2RowCount = Sh2RowCount + 1
End If

Next Sh1RowCount
End With
End Sub
Sub GetData(ByVal StartRow, ByVal EndRow, _
ByVal Sh2RowCount)

'set first so first Line becomes company name
first = True
With Sheets("Sheet1")

For Colcount = 1 To 2
For RowCount = StartRow To EndRow
data = Trim(.Cells(RowCount, Colcount))
If Len(data) > 0 Then
'position of the colon
colonPos = InStr(data, ":")
If colonPos > 0 Then
If colonPos = Len(data) Then
CategoryOnly = True
End If
Category = Left(data, _
InStr(data, ":") - 1)
Else
CategoryOnly = False
End If
If first = True Then
'get company name
Category = "Company"
CategoryOnly = False
first = False
End If

'if ColonPos is 0 data is on next line
'Don't add data to worksheet
If CategoryOnly = False Then
If InStr(data, ":") > 0 Then
data = Trim(Mid(data, _
InStr(data, ":") + 1))
End If
With Sheets("Data")

Select Case Category

Case "Company"
.Cells(Sh2RowCount, "A") = data
Case "Address"
If IsEmpty(.Cells(Sh2RowCount, "B")) Then
.Cells(Sh2RowCount, "B") = data
Else
.Cells(Sh2RowCount, "B") = _
.Cells(Sh2RowCount, "B") & _
";" & data
End If
Case "Phone"
.Cells(Sh2RowCount, "C") = data
Case "Fax"
.Cells(Sh2RowCount, "D") = data
Case "Email"
.Cells(Sh2RowCount, "E") = data
Case "Business Type"
.Cells(Sh2RowCount, "F") = data
Case "Primary Contact"
If IsEmpty(.Cells(Sh2RowCount, "G")) Then
.Cells(Sh2RowCount, "G") = data
Else
.Cells(Sh2RowCount, "G") = _
.Cells(Sh2RowCount, "G") & _
";" & data
End If
End Select
End With
End If
Else
Category = ""
End If
Next RowCount
Next Colcount
End With
End Sub

 

[Jack]

Joel,

Thanks for the answer on this. How would be code work if all the data
resembled the following:

Company
address
city, state
Name
Phone
fax
email
company 2
address
city, state
name
phone

etc.
etc.

Any ideas here??

 

[Joel]

The code wouldn't havve to change the way of have it written except for one
item.
the present code I expected on blank row between companies. There was no
"COMPANY:" in the data you originally sent. The first routine has to be
changed to look for company rather than a blank row. I made the code very
generic that it looks for the Category (Email, Fax). the key with my code is
that it looks for a colon to determine how to process the data.

If it finds the colon it uses everything before it as the category.
Anything after the colon is the data. If there is nothing after the colon it
looks for more data on the next row.

Having data in two columns doesn't cause a problem. The biggest problem is
when does the first company begins and ends and the second company starts.