Database Text File Problem - Macro?

[Joe_Toz]

I am hoping that someone out there might be able to help or point me in the right direction. I currently have a very large text file (generated via Omnipage 15 Pro) of information that must be used to create a customer database. Ideally, the database would have the following fields:
Column1: Indicator (a plus or minus sign, numeric value, etc.)
Column2: Last Name
Column3: First Name
Column4: Year
Column5: Street Address
Column6: City
Column7: State
Column8: Zip
Column9: Phone #
The problem is that the text file is rather choppy and disjointed. The customer records are not uniform in length. Some do not contain enough information for all 9 fields. Most records have more than 1 line of information when opened in Excel. There is, however, some uniformity: the indicator (if any) is always first, followed by last name and then first name. Also, an r: should always precede the address information. The following is a sample of the file:

+WALDON, Mrs. Diana (Diana A. Davies); 1977; r: 555 Hazel Dr.,
Warner Robins, PA 31088, 555 542-7811
+WALDRON, Edwin W.; 1985; Flight Attnd., United Airlines; r: 556
NW 24th St., Miami Shrs., FL 33150;
johndoe@aol.com
WALDRON, Heidi L. (Heidi L. Scheeringa); 1980; r: POB 1234,
Helen, PA 30545
WALDRON, Helen; 1935 (See Ruth, Mrs. Helen)
4-WALDRON, Minerva (Min); 1945; Retired Transcriber/Operator,
State of Florida; r: 557 S. K St., Lake Worth, FL 33460, 55712-
5183
WALENIUS, Mrs. Laura J. (Laura Jayne Doyle); 1961; r: 555
Ridge St., Lake Worth, FL 33460, 555 555-5873
WALENIUS, Richard S.; 1977; r: 5567 S. 9th Ave., Lake Worth,
FL 33461, 555 555-2726
WALKDEN, Arthur B.; 1965; r: 5568 Lake Ave., Lake Worth, FL
33460, 555 555-1889
WALKER, Cassondra; 2000; r: 5569 S. C St., Lake Worth, FL
33460, 555 555-6154
4-WALKER, Cecil; 1954; Retired; r 1234 Jog Rd, Lake Worth, FL
33467, 555 565-6660; Lois; Dale, Keith, Cynthia
WALKER, Charles L.; 1979; r: 123 S B St., Lake Worth, FL 33460
WALKER, David M.; 1969; r: 5570 Dunford Rd., Westlake, OH
44145
4-WALKER, Jeffrey; 1970; Admin., Univ. of Notre Dame; r: 55701
Ray Dr., Granger, IN 46530, 555 555-7541; Shari; Erin, Nathan,
Tim;
johndoe@nd.edu
+WALKER, Jeremy H.; 1991; Maintenance Worker II, Palm Beach
Cnty.; r: 55072 24th St. N, Royal Palm Bch., FL 33412, 555 555-
7311;
johndoe@juno.com
4-WALKER, Lillie (Lillie H. Robinson); 1979; Min ister/Ofc. Mgr.,
Christian Come Alive, 561 369-0950; r: 1234 Fairgreen Rd, W.
Palm Bch., FL 33417, 555 555-8337; Timonthy; Latoya, Laquin-
ton, Timonthy Jr



Please let me know if there are any Macros (or other options) that might help.
Any assistance will be greatly appreciated.
Thanks!

 

[Joe_Toz]

Each line of the real data has a semicolon space r: space preceding the address information as follows:

"; r: "

 

[Joe_Toz]

Also, entering the formula: =FIND("r:",A1) returns values on the applicable rows (i.e. - on rows without address information, the "#Value!" appears).

 

[jindon]

OK, then that is the sign of "No address data" in that line, is it?

 

[Joe_Toz]

Correct, the rows that do not have address data return "#Value!" when the formula: =FIND("r:",A1) is entered.

 

[jindon]

OK, just wait.......

 

[jindon]

we are almost there....

Sub test()
Dim a, w, x, y, z, i, ii
a = Range("a1", Range("a65536").End(xlUp)).Value
For i = LBound(a, 1) To UBound(a, 1)
    If Not IsEmpty(a(i, 1)) Then
        If InStr(a(i, 1), "r:") > 0 Then
            x = Split(a(i, 1), "; r: ")
            y = Split(x(0), ";")
            z = Split(x(1), ",")
            For ii = 1 To 3
                w = Mid(y(0), ii, 1)
                Select Case w
                    Case "A" To "Z", "a" To "z"
                        Exit For
                End Select
            Next
            If ii = 1 Then
                With Range("d1")
                    .Offset(n) = Trim(Left(y(0), InStr(y(0), ",") - 1))
                    .Offset(n, 1) = Trim(Right(y(0), Len(y(0)) - InStr(y(0), ",")))
                    .Offset(n, 2) = Trim(y(1))
                End With
                With Range("g1")
                    .Offset(n).Resize(, UBound(z) + 1) = z
                End With
            Else
                With Range("c1")
                    .Offset(n) = Left(y(0), ii - 1): y(0) = Replace(y(0), .Offset(n), "")
                    .Offset(n, 1) = Trim(Left(y(0), Len(y(0)) - (InStr(y(0), ",")) - 1))
                    .Offset(n, 2) = Trim(Right(y(0), Len(y(0)) - InStr(y(0), ",")))
                    .Offset(n, 3) = Trim(y(1))
                End With
                With Range("g1")
                    .Offset(n).Resize(, UBound(z) + 1) = z
                End With
            End If
        Else
            y = Split(a(i, 1), ";")
            For ii = 1 To 3
                w = Mid(y(0), ii, 1)
                Select Case w
                    Case "A" To "Z", "a" To "z"
                        Exit For
                End Select
            Next
            If ii = 1 Then
                With Range("d1")
                    .Offset(n) = Trim(Left(y(0), InStr(y(0), ",") - 1))
                    .Offset(n, 1) = Trim(Right(y(0), Len(y(0)) - InStr(y(0), ",")))
                    .Offset(n, 2) = Trim(y(1))
                End With
            Else
                With Range("c1")
                    .Offset(n) = Left(y(0), ii - 1)
                    .Offset(n, 1) = Trim(Mid(y(0), ii, Len(y(0)) - ii - InStr(y(0), ",")))
                    .Offset(n, 2) = Trim(Right(y(0), Len(y(0)) - InStr(y(0), ".")))
                    .Offset(n, 3) = Trim(y(1))
                End With
            End If
        End If
        n = n + 1: Erase x, y, z
    End If
Next
End Sub

Code edited:

 

[jindon]

try
State and zip code are still in the same cell
You can clean up the rest with formula with additional column

Sub test()
Dim a, w, x, y, z, i, ii
a = Range("a1", Range("a65536").End(xlUp)).Value
For i = LBound(a, 1) To UBound(a, 1)
    If Not IsEmpty(a(i, 1)) Then
        If InStr(a(i, 1), "r:") > 0 Then
            x = Split(a(i, 1), "; r: ")
            y = Split(x(0), ";")
            z = Split(x(1), ",")
            For ii = 1 To 3
                w = Mid(y(0), ii, 1)
                Select Case w
                    Case "A" To "Z", "a" To "z"
                        Exit For
                End Select
            Next
            If ii = 1 Then
                With Range("d1")
                    .Offset(n) = Trim(Left(y(0), InStr(y(0), ",") - 1))
                    .Offset(n, 1) = Trim(Right(y(0), Len(y(0)) - _
                            InStr(y(0), ",")))
                    .Offset(n, 2) = Trim(y(1))
                End With
                With Range("g1")
                    .Offset(n).Resize(, 4) = z
                End With
            Else
                With Range("c1")
                    .Offset(n) = Left(y(0), ii - 1)
                    y(0) = Replace(y(0), .Offset(n), "")
                    .Offset(n, 1) = Trim(Left(y(0), InStr(y(0), ",") - 1))
                    .Offset(n, 2) = Trim(Right(y(0), Len(y(0)) - _
                            InStr(y(0), ",")))
                    .Offset(n, 3) = Trim(y(1))
                End With
                With Range("g1")
                    .Offset(n).Resize(, 4) = z
                End With
            End If
        Else
            y = Split(a(i, 1), ";")
            For ii = 1 To 3
                w = Mid(y(0), ii, 1)
                Select Case w
                    Case "A" To "Z", "a" To "z"
                        Exit For
                End Select
            Next
            If ii = 1 Then
                With Range("d1")
                    .Offset(n) = Trim(Left(y(0), InStr(y(0), ",") - 1))
                    .Offset(n, 1) = Trim(Right(y(0), Len(y(0)) - InStr(y(0), ",")))
                    .Offset(n, 2) = Trim(y(1))
                End With
            Else
                With Range("c1")
                    .Offset(n) = Left(y(0), ii - 1): y(0) = Replace(y(0), .Offset(n), "")
                    .Offset(n, 1) = Trim(Mid(y(0), ii, Len(y(0)) - InStr(y(0), ",")))
                    .Offset(n, 2) = Trim(Right(y(0), Len(y(0)) - InStr(y(0), ",")))
                    .Offset(n, 3) = Trim(y(1))
                End With
            End If
        End If
        n = n + 1: Erase x, y, z
    End If
Next
End Sub

 

[Joe_Toz]

Jindon,

Thanks alot for your help here. I had to leave work a little early tonight (family function), but will test out your code first thing tomorrow morning. I will absolutely keep you posted.
Thanks again!

JOE

 

[Joe_Toz]

Jindon,

The program worked perfectly on the data sample! Thanks so much for your help. I don’t want to wear out my welcome here, but I was wondering if there was also a way to identify non-conforming records prior to running the macro. The macro does exactly what I need it to do for conforming records (i.e. – records where all information is properly contained in one cell and multiple records are not combined). However, there are many lines of non-conforming records in this text file. If possible, I would like to somehow identify these prior to running the macro. I would then have to manually fix these records, unless there is a better way to handle it. Here is a sample of the non-conforming records:

+WARN, Sueanne R.; 1981 (See Cmehil-Warn, Sueanne R.) 4WARNE, Mrs. Jennifer (Jennifer Rae Callison); 1987; Ad m in.
Asst., Felsing Rankin & Co. CPA; r: 5555 Lyric Dr., Deltona, FL
32738; Jeff.
4+WARNER, Mrs. Roxann (Roxann Bober); 1984; Acctg . Mg r. , Calloway & Price, 5555 Forum Pl., W. Palm Bch., FL 33401, 555 555-0333; r: 55555 55th Rd. N., W. Palm Bch., FL 33412, 555 555-0339; Daniel E.;
johndoe@aol.net
4+WARREN, Shelley; 1969; r: 5555 Warren St., Augusta, GA 30904, 555 555-2672;
johndoe@aol.net
4+WASHAM, Ronald C.; 1975; Owner, Interior Wood Crafts, 555 E
Coast Ave., Hypoluxo, FL 33462, 555 555-4377; r: 555 S. Atlantic Dr. W, Boynton Bch., FL 33435, 555 555-5555; johndoe@aotcom
4+WASHINGTON, Debborrah D.; 1981; Central Processing Dept. Supv., John F. Kennedy Hosp., 5555 S. Congress Ave., Atlantis, FL 33462, 555 555-7300; r: 5555 NW 1st St., Boynton Bch., FL 33435, 555 555-4461; Travaris, Charvis, Malik;
johndoe@aol.net
4+WATERS, Ms. Kawonna S.; 1985; Banking Center Svc. Mgr., Bank of America, 5555 N. Federal Hwy., Boca Raton, FL 33431, 555 555-5883; r: 5555 NE 4th Ct., Boynton Bch., FL 33435, 555 555-8985;
johndoe@aol.net
WATERS, Tracey L.; 1984; Homemaker; r: 5555 Sylvia Ln., Lake Worth, FL 33463, 555 555-6728; Archie Atkins; Justin Atkins WATFORD, Christopher J.; 2001; r: 5555 S. J St., Lake Worth, FL 33460

Once again, many thanks to you and Don for taking the time to look at this.
I really do appreciate it!

JOE

 

[jindon]

Do yoou mean one record consists of 2 rows sometime?