ExcelBanter - Seperate massive data within 1 cell into individual columns

Here is code to get you started. Having one line of data isn't really enough
to get rid of all the errors that could occur. Not sure if the * is in every
column.

The code searches for very specific strings using the INSTR function. If
INSTR doesn't find an exact match it will stop the macro. I could of put
some tests to check if INSTR found the patterns or didn't find the patterns,
but I thought it was better to stop on errors so you can fix the problems.

Make changes as necessary based on any errors you find. I will give
additional help if necessary.

Sub splitCells()

Rows(1).Insert
Range("B1") = "ID"
Range("C1") = "First Name"
Range("D1") = "Second Name"
Range("E1") = "Third Name"
Range("F1") = "Fourth Name"
Range("G1") = "Title"
Range("H1") = "DOB"
Range("I1") = "POB"
Range("J1") = "good a.k.a"
Range("K1") = "Low a.k.a"
Range("L1") = "Nationality"
Range("M1") = "PassPort"
Range("N1") = "national ID"
Range("O1") = "Address"
Range("P1") = "Listed On"
Range("Q1") = "Other"

RowCount = 2
Do While Range("A" & RowCount) < ""
Data = Range("A" & RowCount)
'extract ID Number
SpacePosition = InStr(Data, " ")
Range("B" & RowCount) = Left(Data, SpacePosition - 1)
Data = Trim(Mid(Data, SpacePostion + 1))
'skip Name: 1: , 8 characters
Data = Mid(Data, 9)
'find 2:
CharPosition = InStr(Data, "2:")
'remove characters before 2: not including space
firstName = Trim(Left(Data, CharPosition - 1))
Range("C" & RowCount) = firstName
'remove the 2:
Data = Mid(Data, CharPosition + 2)

'find 3:
CharPosition = InStr(Data, "3:")
'remove characters before 3: not including space
SecondName = Trim(Left(Data, CharPosition - 1))
Range("D" & RowCount) = SecondName
'remove the 3:
Data = Mid(Data, CharPosition + 2)

'find 4:
CharPosition = InStr(Data, "4:")
'remove characters before 4: not including space
ThirdName = Trim(Left(Data, CharPosition - 1))
Range("E" & RowCount) = ThirdName
'remove the 4:
Data = Mid(Data, CharPosition + 2)

'find Title:
CharPosition = InStr(Data, "Title:")
'remove characters before 4: not including space
FourthName = Trim(Left(Data, CharPosition - 1))
Range("F" & RowCount) = FourthName
'remove the 4:
Data = Mid(Data, CharPosition + 6)

'get title
'find DOB:
CharPosition = InStr(Data, "DOB:")
'remove characters before DOB: not including space
Title = Trim(Left(Data, CharPosition - 1))
Range("G" & RowCount) = Title
'remove the DOB:
Data = Mid(Data, CharPosition + 4)

'get DOB
'find POB:
CharPosition = InStr(Data, "POB:")
'remove characters before POB: not including space
DOB = Trim(Left(Data, CharPosition - 1))
Range("H" & RowCount) = DOB
'remove the POB:
Data = Mid(Data, CharPosition + 4)

'get POB
'find *Good quality a.k.a.:
CharPosition = InStr(Data, "*Good quality a.k.a.:")
'remove characters before a.k.a: not including space
POB = Trim(Left(Data, CharPosition - 1))
Range("I" & RowCount) = POB
'remove the a.k.a:
Data = Mid(Data, CharPosition + 21)

'get Good Quality A.K.A
'find *Low quality a.k.a.:
CharPosition = InStr(Data, "Low quality a.k.a.:")
'remove characters before a.k.a: not including space
GoodAKA = Trim(Left(Data, CharPosition - 1))
Range("J" & RowCount) = GoodAKA
'remove the a.k.a:
Data = Mid(Data, CharPosition + 20)

'get Low Quality A.K.A
'find *Nationality:
CharPosition = InStr(Data, "*Nationality:")
'remove characters before Nationality: not including space
LowAKA = Trim(Left(Data, CharPosition - 1))
Range("K" & RowCount) = LowAKA
'remove the *Nationality:
Data = Mid(Data, CharPosition + 13)

'get Nationality
'find Passport no.:
CharPosition = InStr(Data, "Passport no.:")
'remove characters before Passport no.: not including space
Nationality = Trim(Left(Data, CharPosition - 1))
Range("L" & RowCount) = Nationality
'remove the Passport no.:
Data = Mid(Data, CharPosition + 13)

'get Passport
'find National identification no.:
CharPosition = InStr(Data, "National identification no.:")
'remove characters before ID: not including space
Passport = Trim(Left(Data, CharPosition - 1))
Range("M" & RowCount) = Passport
'remove the National identification no.:
Data = Mid(Data, CharPosition + 28)

'get National ID
'find Address:
CharPosition = InStr(Data, "Address:")
'remove characters before Address: not including space
NationalID = Trim(Left(Data, CharPosition - 1))
Range("N" & RowCount) = NationalID
'remove the Address:
Data = Mid(Data, CharPosition + 8)

'get Address
'find *Listed on:
CharPosition = InStr(Data, "*Listed on:")
'remove characters before Listed on: not including space
Address = Trim(Left(Data, CharPosition - 1))
Range("O" & RowCount) = Address
'remove the Listed on
Data = Mid(Data, CharPosition + 11)

'get Listed on
'find *Other information:
CharPosition = InStr(Data, "*Other information:")
'remove characters before *Other information: not including space
Listed = Trim(Left(Data, CharPosition - 1))
Range("P" & RowCount) = Listed
'remove the *Other information:
Data = Mid(Data, CharPosition + 19)

'get other
Other = Trim(Data)
Range("Q" & RowCount) = Other

RowCount = RowCount + 1
Loop
End Sub

"macropod" wrote:

Any macro or fast manual method?
Only one: get the person who created the file to supply it in a delimited format (eg with comas or tabs separating the fields), and
with a single header row instead of including the field descriptions in the data.

Failing, that, Text-to-Columns with a colon delimiter (ie ':') will get you started - you can then do a Find/Replace on each column
to delete the field descriptions - which almost invariably fall at the end of the previous column's text.

Cheers
--
macropod
[MVP - Microsoft Word]
-------------------------

wrote in message oups.com...
I'm trying to separate a tons of data into individual fields with its
own column for each title. The data in one individual cell (A1) looks
like this:

TI.A.38.01. *Name: 1: ABDUL BAQI 2: na 3: na 4: na Title: a) Maulavi
b) Mullah Designation: a) Governor of the provinces of Khost and
Paktika under the Taliban regime b) Vice-Minister of Information and
Culture under the Taliban regime c) Consulate Dept., Ministry of
Foreign Affairs under the Taliban regime DOB: Approximately 1962 POB:
Jalalabad city, Nangarhar province, Afghanistan *Good quality a.k.a.:
na Low quality a.k.a.: na *Nationality: Afghan Passport no.: na
National identification no.: na Address: na *Listed on: 23 Feb. 2001
(amended on 7 Sep. 2007 and 21 Sep. 2007) *Other information: Believed
to be in the Afghanistan/Pakistan border area. Until 7 Sep. 2007 he
was also listed under number TI.A.48.01.

I need to separate them into individual column according to the given
field listed above. I have 1500 of these cell lined up on Column A, I
need to sperate them all at once to save time. Are there any solution
to resolve this problem? Any macro or fast manual method?

Thanks a million!

Alyse