Separate field into multiple records

[Sean Clayton]

I need a bit of advice, and my brain is starting to melt trying to
think out the problem.

Here's my situation. I have an Access table, populated automatically
from a scannable paper form. One of the fields on this form dumps its
data into a single field in the table for a given person. The field in
question asks for medical history on the patient, and most often it
will have several different items in the field, seperated by a double
space since the scanning software won't accept any kind of punctuation
in that field.

I need to put together a query or a series of them to break out this
list of items into a new table, along with the associated number and
name for that patient. For example, if the form dumps out:

Number LName MedHist
12345 Doe Kidney Stones Heart attack Broken arm

then I need to append to another table:

Number LName MedHist
12345 Doe Kidney Stones
12345 Doe Heart attack
12345 Doe Broken arm

Is there a way that this can be done?

 

[Pieter Wijnen]

Sure
Check Out the Split Function (A2K >, A'97 substitute below)

Pieter

Private Function Split(ByVal s As String, Optional ByVal Ch As String = "
") As Variant
' Not Needed In Access 2000 +
' Note Must be returned to a variant

Dim R() As String
Dim i As Long, Pos As Long
Pos = VBA.InStr(s, Ch)
While Pos
ReDim Preserve R(i) As String
R(i) = VBA.Left(s, Pos - 1)
i = i + 1
s = VBA.Mid(s, Pos + 1)
Pos = VBA.InStr(s, Ch)
Wend
ReDim Preserve R(i) As String
R(i) = s
Split = R
End Function

 

[Sean Clayton]

Sure

Check Out the Split Function (A2K >, A'97 substitute below)

Pieter

Private Function Split(ByVal s As String, Optional ByVal Ch As String = "
") As Variant
' Not Needed In Access 2000 +
' Note Must be returned to a variant

Dim R() As String
Dim i As Long, Pos As Long
Pos = VBA.InStr(s, Ch)
While Pos
ReDim Preserve R(i) As String
R(i) = VBA.Left(s, Pos - 1)
i = i + 1
s = VBA.Mid(s, Pos + 1)
Pos = VBA.InStr(s, Ch)
Wend
ReDim Preserve R(i) As String
R(i) = s
Split = R
End Function

I apologize for my ignorance, but I'm having a hard time understanding
how to use that code. I understand the Split function and the
arguments that make it work, but I'm unable to figure out how to use
it in that code.

 

[Pieter Wijnen]

Example

Dim Res As Variant
Dim i As Long
Dim Db As DAO.Dtabase

Set Db = Access.CurrentDb

Res = Split("A B C")

For i = LBound(Res) To UBound(Res)
Debug.Print Res(i)
Db.Execute "INSERT INTO MyTable (MyField) VALUES ('" & Res(i) & "'"),
DAO.dbSeeChanges
Next

Pieter

 

[Sean Clayton]

Okay, I got it to work great once, but I'm having trouble adapting it
to a slightly different purpose.

Here's what I've got. My code takes this...

MRN Medications
12345 Amoxil 20mg Penicillin 30mg Codeine 10mg

....and puts it in a new table as this...

MRN Medications
12345 Amoxil 20 mg
12345 Penicillin 30 mg
12345 Codeine 10 mg

....based on the double spaces between the meds. Here's the code:

---Code starts---
Sub PopulateCF_MedBK1()

Dim dbCurr As DAO.Database
Dim rsOldData As DAO.Recordset
Dim lngLoop As Long
Dim lngMRN As Long
Dim strCompl As String
Dim strSQL As String
Dim varCompl As Variant

strSQL = "SELECT MRN, Medications FROM CF_Working"
Set dbCurr = CurrentDb()
Set rsOldData = dbCurr.OpenRecordset(strSQL)
Do While rsOldData.EOF = False
lngMRN = rsOldData!MRN
strCompl = rsOldData!Medications
varCompl = Split(strCompl, " ")
If IsNull(varCompl) = False Then
For lngLoop = LBound(varCompl) To UBound(varCompl)
strSQL = "INSERT INTO CF_MedBK1 (MRN, Medications) " & _
"VALUES (" & lngMRN & ", '" & varCompl(lngLoop) &
"')"
dbCurr.Execute strSQL, dbFailOnError
Next lngLoop
End If
rsOldData.MoveNext
Loop

rsOldData.Close
Set rsOldData = Nothing
Set dbCurr = Nothing

End Sub

---Code ends---

That works fine. What I want to do now is take the result...

MRN Medications
12345 Amoxil 20 mg
12345 Penicillin 30 mg
12345 Codeine 10 mg

....and put it in a new table as this...

MRN Medications Dose Unit
12345 Amoxil 20 mg
12345 Penicillin 30 mg
12345 Codeine 10 mg

....based on the single space between them. The code I've got thus far:

---Code starts---
Sub PopulateCF_MedBK2()

Dim dbCurr As DAO.Database
Dim rsOldData As DAO.Recordset
Dim lngLoop As Long
Dim lngMRN As Long
Dim strCompl As String
Dim strComp2 As String
Dim strComp3 As String
Dim strSQL As String
Dim varCompl As Variant
Dim varComp2 As Variant
Dim varComp3 As Variant

strSQL = "SELECT MRN, Medications FROM CF_MedBK1"
Set dbCurr = CurrentDb()
Set rsOldData = dbCurr.OpenRecordset(strSQL)
Do While rsOldData.EOF = False
lngMRN = rsOldData!MRN
strCompl = rsOldData!Medications
varCompl = Split(strCompl, " ")
strComp2 = rsOldData!Medications
varComp2 = Split(strComp2, " ")
strComp3 = rsOldData!Medications
varComp3 = Split(strComp3, " ")
If IsNull(varCompl) = False Then
For lngLoop = LBound(varCompl) To UBound(varCompl)
strSQL = "INSERT INTO CF_MedBK2 (MRN, Medications, Dose,
Unit) " & _
"VALUES (" & lngMRN & ", '" & varCompl(lngLoop) & "',
'" & varComp2(lngLoop) & "', '" & varComp3(lngLoop) & "')"
dbCurr.Execute strSQL, dbFailOnError
Next lngLoop
End If
rsOldData.MoveNext
Loop

rsOldData.Close
Set rsOldData = Nothing
Set dbCurr = Nothing

End Sub

---Code ends---

As it sits now, it comes out with this...

MRN Medications Dose Unit
12345 Amoxil Amoxil Amoxil
12345 20 20 20
12345 mg mg mg
12345 Penicillin Penicillin Penicillin
12345 30 30 30
12345 mg mg mg
12345 Codeine Codeine Codeine
12345 10 10 10
12345 mg mg mg

Where might I be wrong?

 

[Douglas J. Steele]

No need to use the Split function 3 times:

Do While rsOldData.EOF = False
lngMRN = rsOldData!MRN
strCompl = rsOldData!Medications
varCompl = Split(strCompl, " ")
If IsNull(varCompl) = False Then
strSQL = "INSERT INTO CF_MedBK2 (MRN, Medications, Dose, Unit) " & _
"VALUES (" & lngMRN & ", '" & varCompl(0) & "', _
'" & varCompl(1) & "', '" & varCompl(3) & "')"
dbCurr.Execute strSQL, dbFailOnError
End If
rsOldData.MoveNext
Loop

However, what happens if the medication name has two or more words in it?
("Children's Aspirin")

Dose and Unit will always be varComp(UBound(varComp) - 1) and
varComp(UBound(varComp)) respectively, but somehow you're going to need to
put the first bit back together:

Do While rsOldData.EOF = False
lngMRN = rsOldData!MRN
strCompl = rsOldData!Medications
varCompl = Split(strCompl, " ")
If IsNull(varCompl) = False Then
If UBound(varCompl) = 2 Then
strSQL = "INSERT INTO CF_MedBK2 (MRN, Medications, Dose, Unit) " & _
"VALUES (" & lngMRN & ", '" & varCompl(0) & "', " & _
varCompl(1) & "', '" & varCompl(2) & "')"
Else
For lngLoop = LBound(varCompl) To UBound(varCompl) - 2
strMedication = strMedication & " " & varCompl(lngLoop)
Next lngLoop
strMedication = Trim(strMedication)
strSQL = "INSERT INTO CF_MedBK2 (MRN, Medications, Dose, Unit) " & _
"VALUES (" & lngMRN & ", '" & strMedication & "', " & _
varComp(UBound(varCompl) - 1) & "', '" & _
varComp(UBound(varCompl)) & "')"
End If
dbCurr.Execute strSQL, dbFailOnError
End If
rsOldData.MoveNext
Loop

 

[Sean Clayton]

I had planned to just eliminate the spaces from any possible two-plus
worded meds, since there aren't that many anyway, but your code is
intriguing.

However, I'm hitting a snag with both of them, and evidently I'm not
seeing clearly. Replacing the code I had with what you posted gives
me, after adjustment to make variable names match, a 'type mismatch'
error. All the fields in the source and destination tables are text,
so I'm confused on how this could happen.

 

[Douglas J. Steele]

In case one of us made a typo, copy-and-paste your code into your reply.

 

[Sean Clayton]

Alrighty. Here we go:

---code starts---

Sub PopulateCF_MedBK2()

Dim dbCurr As DAO.Database
Dim rsOldData As DAO.Recordset
Dim lngLoop As Long
Dim lngMRN As Long
Dim strCompl As String
Dim strComp2 As String
Dim strComp3 As String
Dim strSQL As String
Dim varComp As Variant
Dim varCompl As Variant
Dim varComp2 As Variant
Dim varComp3 As Variant

strSQL = "SELECT MRN, Medications FROM CF_MedBK1"
Set dbCurr = CurrentDb()
Set rsOldData = dbCurr.OpenRecordset(strSQL)
Do While rsOldData.EOF = False
lngMRN = rsOldData!MRN
strCompl = rsOldData!Medications
varCompl = Split(strCompl, " ")
If IsNull(varCompl) = False Then
strSQL = "INSERT INTO CF_MedBK2 (MRN, Medications, Dose, Unit) "
& _
"VALUES (" & lngMRN & ", '" & varCompl & "', '" & varComp2 &
"', '" & varComp3 & "')"
dbCurr.Execute strSQL, dbFailOnError
End If
rsOldData.MoveNext
Loop

rsOldData.Close
Set rsOldData = Nothing
Set dbCurr = Nothing

End Sub

---code ends---

 

[Douglas J. Steele]

That's not what I suggested....

If IsNull(varCompl) = False Then
strSQL = "INSERT INTO CF_MedBK2 (MRN, Medications, Dose, Unit) " & _
"VALUES (" & lngMRN & ", '" & varCompl(0) & "', '" & varCompl(1) &
"', '" & varCompl(2) & "')"
dbCurr.Execute strSQL, dbFailOnError
End If

If that still fails, put

Debug.Print strSQL

in front of the dbCurr.Execute strSQL, dbFailOnError statement, and check
what the SQL actually looks like.

 

[Pieter Wijnen]

You should only run the Split once!
.....
varCompl = Split(strCompl, " ")
strSQL = "INSERT INTO CF_MedBK2 (MRN, Medications, Dose, Unit) " & _
"VALUES (" & lngMRN & ", '" & varCompl(0) & "', varComp1(1)
& "', '" & varComp2(2) & "')"
dbCurr.Execute strSQL, dbFailOnError
......
HTH

Pieter

 

[Sean Clayton]

I'm starting to feel stupid here...

Replacing my If...End If with yours gets me a new error
message...'Subscript out of range'. Apparently, the error is centered
on varCompl(1) and varCompl(2). Might be because the record it's
trying to process doesn't have a dosage or unit...not all of them do.
I should have mentioned that earlier...my apologies.

 

[Douglas J. Steele]

You'll need to include logic to check the value of UBound(varCompl).

If it's 2, your code should run fine.

If it's 0, that implies you have neither dosage nor unit.

If it's 1, you may have a problem <g> How will you know whether it's missing
the dosage or the unit?

 

[Sean Clayton]

Well, this information comes from the paper scannable forms, and all
information has to be verified before it goes into the database. I can
make any edits that need to be made to the info then.