P
Paul
I have a table with the fields "Last Name" and "First Name". A person can
have multiple versions of the First Name and it is saved in the First Name
field seperated by a "Comma" and Space like John, Jimmy, Jan etc and the
Last Name is "Doe". I need to seperate each version of the first name and
create a new record for it. As in this case there are three records and I
tried to write a vba to achieve this and it did not work. Thanks
Option Compare Database
Option Explicit
Sub ParsingName()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim a, b, c, Find1, Find2 As Integer
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Test1")
'Retrieve and prepare all Internal Award records for calculation
Do While Not rs1.EOF
With rs1
Set rs2 = db.OpenRecordset("Test2")
a = 0
c = 0
Find1 = 0
Find2 = 0
b = Len(rs1!FirstName)
a = b
Do
Find1 = InStr(Mid(rs1!FirstName, a, 1), ",")
If Find1 > 0 Then
c = a - 1
Do
Find2 = InStr(Mid(rs1!FirstName, c, 1), ",")
c = c - 1
Loop Until (Find2 > 0) Or c = 0
rs2.AddNew
rs2!LastName = rs1!LastName
If Find2 > 0 Then
If c = 0 Then
rs2!FirstName = Mid(rs1!FirstName, a,
InStr(Mid(rs1!FirstName, a, 20), ","))
Else
rs2!FirstName = Mid(rs1!FirstName, a + 2, a - c
+ 1)
End If
Else
rs2!FirstName = Mid(rs1!FirstName, a + 2,
InStr(Mid(rs1!FirstName, a, 20), ",") + 5)
End If
rs2.Update
End If
a = a - 1
Loop Until (a = 0)
End With
rs1.MoveNext
Loop
rs2.Close
rs1.Close
db.Close
Set db = Nothing
Set rs2 = Nothing
Set rs1 = Nothing
End Sub
have multiple versions of the First Name and it is saved in the First Name
field seperated by a "Comma" and Space like John, Jimmy, Jan etc and the
Last Name is "Doe". I need to seperate each version of the first name and
create a new record for it. As in this case there are three records and I
tried to write a vba to achieve this and it did not work. Thanks
Option Compare Database
Option Explicit
Sub ParsingName()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim a, b, c, Find1, Find2 As Integer
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Test1")
'Retrieve and prepare all Internal Award records for calculation
Do While Not rs1.EOF
With rs1
Set rs2 = db.OpenRecordset("Test2")
a = 0
c = 0
Find1 = 0
Find2 = 0
b = Len(rs1!FirstName)
a = b
Do
Find1 = InStr(Mid(rs1!FirstName, a, 1), ",")
If Find1 > 0 Then
c = a - 1
Do
Find2 = InStr(Mid(rs1!FirstName, c, 1), ",")
c = c - 1
Loop Until (Find2 > 0) Or c = 0
rs2.AddNew
rs2!LastName = rs1!LastName
If Find2 > 0 Then
If c = 0 Then
rs2!FirstName = Mid(rs1!FirstName, a,
InStr(Mid(rs1!FirstName, a, 20), ","))
Else
rs2!FirstName = Mid(rs1!FirstName, a + 2, a - c
+ 1)
End If
Else
rs2!FirstName = Mid(rs1!FirstName, a + 2,
InStr(Mid(rs1!FirstName, a, 20), ",") + 5)
End If
rs2.Update
End If
a = a - 1
Loop Until (a = 0)
End With
rs1.MoveNext
Loop
rs2.Close
rs1.Close
db.Close
Set db = Nothing
Set rs2 = Nothing
Set rs1 = Nothing
End Sub