Split by Commas and add to new table (1 Viewer)

' ----------------------------------------------------------------
' Procedure Name: FixGrower
' Purpose: To parse growercodes and create individual records.
' from --https://www.access-programmers.co.uk/forums/showthread.php?t=304627
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jack
' Date: 09-Apr-19
' ----------------------------------------------------------------
Sub FixGrower()
    On Error GoTo FixGrower_Error
          Dim db As DAO.Database
          Dim rs1 As DAO.Recordset
          Dim rs2 As DAO.Recordset
          Dim mystring As Variant
          Dim i As Integer
10    Set db = CurrentDb
20    Set rs2 = db.OpenRecordset("Copy of GrowerInfo")
30    Set rs1 = db.OpenRecordset("Select grower, Location, growerCode from GrowerInfo")
40    Do While Not rs1.EOF
50      If InStr(rs1!growercode, ",") > 0 Then
60          mystring = Split(rs1!growercode, ",")
70          For i = LBound(mystring) To UBound(mystring)
80              rs2.AddNew
90              rs2!grower = rs1!grower
100             rs2!Location = rs1!Location
110             rs2!growercode = mystring(i)
120             rs2.Update
130         Next i
140     Else
150         rs2.AddNew
160         rs2!grower = rs1!grower
170         rs2!Location = rs1!Location
180         rs2!growercode = rs1!growercode
190         rs2.Update
200     End If
210     rs1.MoveNext
220   Loop
    
    On Error GoTo 0
    Exit Sub

FixGrower_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FixGrower, line " & Erl & "."

End Sub

  'take a field with codes that are comma delim, and break up into single records.
Public Sub ParseCommaFlds()
Dim rst 'As Recordset
Dim vLoc, vGrwr, vCode, vWord
Dim sSql As String
Dim i As Integer
Const kTARGtbl = "tParsed"

'source tbl: t2Parse
'target tbl: tParsed

DoCmd.SetWarnings False

Set rst = CurrentDb.OpenRecordset("t2Parse")
With rst
  While Not .EOF
          'get next record
        vGrwr = .Fields("Grower").Value
        vLoc = .Fields("Location").Value
        vWord = .Fields("GrowerCode").Value
            
           'breakup codes
        i = InStr(vWord, ",")
        While i > 0
           vCode = Trim(Left(vWord, i - 1))
           GoSub Post1Rec
           
           vWord = (Mid(vWord, i + 1))
           i = InStr(vWord, ",")
        Wend
        
        vCode = Trim(vWord)
        GoSub Post1Rec
        
        .MoveNext
  Wend
End With

DoCmd.SetWarnings False

Set rst = Nothing
DoCmd.OpenTable kTARGtbl
Exit Sub

Post1Rec:
  sSql = "Insert into " & kTARGtbl & " (Grower,Location,GrowerCode) values ('" & vGrwr & "','" & vLoc & "','" & vCode & "')"
  DoCmd.RunSQL sSql
  Return
End Sub

Public Sub UpdateCodes()
  Const tblName = "tblGrower"
  Dim rs As DAO.Recordset
  Dim aCodes() As String
  Dim Location As String
  Dim Grower As String
  Dim i As Integer
  Set rs = CurrentDb.OpenRecordset(tblName)
  Do While Not rs.EOF
    aCodes = Split(rs!GrowerCode, ",")
    Location = rs!Location
    Grower = rs!Grower
    rs.Edit
      rs!GrowerCode = aCodes(0)
    rs.Update
    If UBound(aCodes) > 0 Then
      For i = 1 To UBound(aCodes)
        rs.AddNew
          rs!Location = Location
          rs!Grower = Grower
          rs!GrowerCode = aCodes(i)
        rs.Update
      Next i
    End If
    rs.MoveNext
  Loop
End Sub