Address & Name maniplations

[Lamb Chop]

I have a list of the contact list exported from a software which I have no
control of what it generate.

For example,

Column A Column B
Surname: Smith Title: Prof
First Name: John Email: (e-mail address removed)
Address: Virtual Street
State: Victoria
Postcode: 1299
Home Number: 123456
Fax: 456789
Mobile: 98765
<empty row.>
Surname: Peters Occupation: Teacher
First Name: Davis Email: (e-mail address removed)
Address: Virtual Street
Home Number: 99999
Mobile: 98765
<Empty row>
<another record starts>
....
....
...
etc...


I need to put the name, Home nuimber and emails into a single column and
separate the fields by #, e.g.

John Smith#123456#[email protected]
Davis Peters#99999#[email protected]
....
...
....


The trick of the data is that the lenght of the records are not the same,
e.g. some missed the Fax number, some missed the address. Therefore, some
records occupy 5 rows and some with 6 or 7 rows. Some use 2 columns, while
some use only 1 column. (never more than two columns).
Between each record there is a empty row to separate them.

All the field started with some key words, e.g. "Surname:", "First Name:",
"email:" etc

Any suggestion?

Thanks in advance.

 

[Max]

One way which might do it ..

Assuming data in cols A and B, from row1 down

In C1:
=IF(SUMPRODUCT(--ISNUMBER(SEARCH({"Surname";"First Name";"Home
Number"},A1)))>0,TRIM(MID(A1,SEARCH(":",A1)+1,99)),"")

In D1:
=IF(AND(C1<>"",C2<>""),C2&" "&C1,"")

In E1:
=IF(ISNUMBER(SEARCH("Email",B1)),TRIM(MID(B1,SEARCH(":",B1)+1,99)),"")

In F1:
=IF(D1="","",ROW())

In G1:
=INDEX(D,SMALL(F:F,ROW()))

In H1:
=IF(ISNUMBER(C1+0),ROW(),"")

In I1:
=INDEX(C:C,SMALL(H:H,ROW()))

In J1:
=IF(E1="","",ROW())

In K1:
=INDEX(E:E,SMALL(J:J,ROW()))

Finally, in L1:
=IF(G1="","",G1&"#"&I1&"#"&K1)

Then just select C1:L1, copy down to the last row of source data in col A.
Col L should return the required results bunched at the top (till #NUM!
appears). Tested ok on your sample data as posted.

 

[Dave Peterson]

First, your fields aren't really separated by "#"--well, in your example, you
have first name and surname combined into one field (albeit separated by a
space).

The other thing that looks like a problem to me is that if fields are missing in
the real data, then your # separated file will not be in any particular order.
(I'm not sure how anyone/anything could tell a difference between the home
phone, fax, and mobile phone numbers for instance.)

If I wanted to manipulate this data, the first thing I would do would put it in
a nicer format--one row per "record". All the Surnames would be in one column,
all the emails would be in another. (Empty cells would be fine.)

Then after I have that, I could manipulate the data easier--I could build
formulas that build exactly what I need.

=a1 & " " & e1 & "#" & b1 & "#" & "#" & c1
& if(d1="","",text(d1,"000-000-0000") & ...


kind of thing.

If that makes sense to you, you may want to try a macro that flattens your data
into rows:

Option Explicit
Sub testme01()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim DestCell As Range
Dim oRow As Long
Dim ColonPos As Long
Dim res As Variant
Dim iCol As Long
Dim myStr As String

Dim myCellToInspect As Range
Dim myCell As Range
Dim myRng As Range

Set CurWks = Worksheets("sheet1")
Set NewWks = Worksheets.Add

With CurWks
Set DestCell = NewWks.Range("A1")
.Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Copy _
Destination:=DestCell

With NewWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
.Range("b1", .Cells(.Rows.Count, "B").End(xlUp)).Copy _
Destination:=DestCell
End With

With NewWks
.Range("A:a").Replace what:=":*", replacement:="", _
lookat:=xlPart, MatchCase:=False

.Rows(1).Insert
.Range("a1").Value = "Header"

.Range("a:a").AdvancedFilter action:=xlFilterCopy, _
copytorange:=.Range("b1"), unique:=True

.Range("a1").EntireColumn.Delete

.Range("a:a").Sort key1:=.Columns(1), order1:=xlAscending, _
header:=xlYes

.Range("a2", .Cells(.Rows.Count, "A").End(xlUp)).Copy
.Range("b1").PasteSpecial Transpose:=True
.Range("a1").EntireColumn.Delete
End With

oRow = 2 'after the headers
With CurWks
Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
For Each myCell In myRng.Cells
If IsEmpty(myCell.Value) Then
oRow = oRow + 1
Else
For iCol = 1 To _
.Cells(myCell.Row, .Columns.Count).End(xlToRight).Column
Set myCellToInspect = myCell.Offset(0, iCol - 1)

If IsEmpty(myCellToInspect.Value) Then
'do nothing
Else
ColonPos = InStr(1, myCellToInspect.Value, ":", _
vbTextCompare)
If ColonPos = 0 Then
MsgBox "No colon in: " _
& myCellToInspect.Address(0, 0)
Else
myStr = Trim(Mid(myCellToInspect.Value, _
ColonPos + 1))
res = _
Application.Match(Left(myCellToInspect.Value, _
ColonPos - 1), NewWks.Rows(1), 0)
If IsError(res) Then
MsgBox "Error with: " _
& myCellToInspect.Address(0, 0)
Else
NewWks.Cells(oRow, res).Value = myStr
End If
End If
End If
Next iCol
End If
Next myCell
End With

NewWks.UsedRange.Columns.AutoFit

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

The first part of the routine copies columns A and B to a single column in a new
sheet. It gets rid of the real data (the .replace), but keeps those keywords.
Then it winnows it down to a single entry for each keyword and sorts that list
and plops it in row 1 (transpose:=true).

Then the second part does all the work. It looks at each cell and figures out
which column has the keyword and gets the entry.

 

[Max]

Here's a sample working construct to illustrate the earlier suggestion:
http://www.savefile.com/files/191660
Address n Name Manipulations.xls