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 said:
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]
-------------------------
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
