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:

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

Jack

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" wrote:

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:

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

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" wrote:

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" wrote:

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:

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

Jack