This takes a field delimited by commas, and splits on the comma. The newly divided information is put in another field (created at the start of the program) called lob
. Each part of the split is put in the lob
field in a duplicate record of the original record from before the split. The primary key is ID which is automatically generated.
Here is a concise example of desired behavior (many fields omitted for visual clarity):
Before running the module:
+--------------------------------------------+ | ID | App Code | Lines Of Business | +-------+-----------+------------------------+ | 1 | AB23 | Value1, Value 2,Value3 | +------ +-----------+------------------------+ | 2 | XY45 | Value 2 | +--------------------------------------------+
After running the module:
+-------------------------------------------------------+ | ID | App Code | Lines Of Business | lob | +-------+-----------+------------------------+----------+ | 1 | AB23 | Value1, Value 2,Value3 | Value1 | +-------+-----------+------------------------+----------+ | 2 | XY45 | Value 2 | Value 2 | +-------+-----------+------------------------+----------+ | 3 | AB23 | Value1, Value 2,Value3 | Value 2 | +-------+-----------+------------------------+----------+ | 4 | AB23 | Value1, Value 2,Value3 | Value3 | +-------------------------------------------------------+
Is there a way to accomplish this task in a more elegant or accurate way? Efficiency is also good, but this program already runs quick enough on my data-set.
Option Explicit
Public Sub ReformatTable()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsADD As DAO.Recordset
Dim fld As DAO.Field
Dim strSQL As String
Dim varData As Variant
Dim i As Integer
Set db = CurrentDb
' Add a field into the existing IIPM table called lob.
' Values created during the Line Of Business split will be stored here.
Dim strDdl As String
strDdl = "ALTER TABLE IIPM ADD COLUMN lob TEXT(255);"
CurrentProject.Connection.Execute strDdl
' Select all fields that have a Line of Business and are unprocessed (lob is Null)
strSQL = "SELECT *, lob FROM IIPM WHERE ([Lines Of Business] Is Not Null) AND ([lob] Is Null)"
Set rsADD = db.OpenRecordset("IIPM", dbOpenDynaset, dbAppendOnly)
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
With rs
While Not .EOF
varData = Split(rs![Lines Of Business], ",") ' Get all comma delimited fields
'Update First Record
.Edit
!lob = Trim(varData(0)) ' remove spaces before writing new fields
.Update
' Add records with same first field
' and new fields for remaining data at end of string
For i = 1 To UBound(varData)
rsADD.AddNew
For Each fld In rsADD.Fields
If fld.Name <> "lob" And fld.Name <> "ID" Then
' Copy all fields except "lob" and "ID"
rsADD(fld.Name) = rs(fld.Name)
End If
Next fld
' lob is set separately, ID is set automatically
rsADD!lob = Trim(varData(i)) ' remove spaces before writing new fields
rsADD.Update
Next i
.MoveNext
Wend
.Close
rsADD.Close
End With
Set rsADD = Nothing
Set rs = Nothing
' Remove empty rows which only contain an ID.
CurrentProject.Connection.Execute "DELETE FROM IIPM WHERE lob IS NULL AND [App Code] IS NULL AND [Lines Of Business] IS NULL;"
db.Close
Set db = Nothing
End Sub