DoCmd.SetWarnings False
On Error Resume Next
Dim GrapeCnt, IntGrapeID, IntPunctPos As Integer
Dim GrapeOrgStr, GrapeTrimStr, GrapeSendStr As String
Dim QryAppend, QryDelRec As String
'determine number of grapes to be normalised
GrapeCnt = DCount("grapeid", "tbl_grape1")
While GrapeCnt > 0
'determine next recrod to be nomalised
IntGrapeID = DLookup("grapeID", "tbl_grape1", "grapeID = " & DMin("grapeID", "tbl_grape1"))
'Determine String to be normalised
GrapeOrgStr = DLookup("Grape", "tbl_grape1", "grapeID = " & IntGrapeID)
'MsgBox "Next text to be normalised is " & GrapeOrgStr
'Check record for commas or ampersands
'to work this portion of the code relies on commas always proceeding ampersands
If InStr(1, GrapeOrgStr, ",") > 0 Then 'Check if text contains a comma and record postion
IntPunctPos = InStr(1, GrapeOrgStr, ",")
ElseIf InStr(1, GrapeOrgStr, "&") > 0 Then 'Check if text contains a ampersand and record postion
IntPunctPos = InStr(1, GrapeOrgStr, "&")
End If
If IntPunctPos <> 0 Then 'Check if commas or ampersands detected then cycle through text removing and append data to new table
'MsgBox "we have work to do"
While IntPunctPos > 0
GrapeSendStr = Left(GrapeOrgStr, IntPunctPos - 1)
QryAppend = "INSERT INTO TBL_Grape2 ( Grape )" & _
"values ( " & Chr(34) & GrapeSendStr & Chr(34) & " ) ;"
If DCount("[Grape]", "tbl_grape2", "[grape] = '" & Chr(34) & GrapeSendStr & Chr(34) & "'") < 1 Then 'check if this grape already exsists and skip
DoCmd.RunSQL (QryAppend)
End If
If (Len(GrapeOrgStr) - (IntPunctPos + 1)) > 1 Then
GrapeTrimStr = Right(GrapeOrgStr, (Len(GrapeOrgStr) - (IntPunctPos + 1)))
GrapeOrgStr = GrapeTrimStr
End If
IntPunctPos = 0
If InStr(1, GrapeOrgStr, ",") > 0 Then 'Check if text contains a comma and record postion
IntPunctPos = InStr(1, GrapeOrgStr, ",")
ElseIf InStr(1, GrapeOrgStr, "&") > 0 Then 'Check if text contains a ampersand and record postion
IntPunctPos = InStr(1, GrapeOrgStr, "&")
End If
Wend
Else 'If no commas or ampersands detected simply append current record to new table
QryAppend = "INSERT INTO TBL_Grape2 ( Grape ) " & _
"SELECT TBL_Grape1.Grape " & _
"FROM TBL_Grape1 " & _
"WHERE (((TBL_Grape1.GrapeID)= " & IntGrapeID & " ));"
DoCmd.RunSQL (QryAppend)
End If
End If
'Delete first record once appended to new Table
QryDelRec = "DELETE TBL_Grape1.GrapeID, TBL_Grape1.Grape " & _
"FROM TBL_Grape1 " & _
"WHERE (((TBL_Grape1.GrapeID)= " & IntGrapeID & "));"
DoCmd.RunSQL (QryDelRec)
'Update GrapeCnt with new record total
GrapeCnt = DCount("grapeid", "tbl_grape1")
Wend
DoCmd.SetWarnings True
End Sub