Rx_
Nothing In Moderation
- Local time
- Today, 12:21
- Joined
- Oct 22, 2009
- Messages
- 2,803
Long ago, a free-form text field was created so users could enter some ID numbers. Over time, the ID numbers became multiple ID numbers in one column.
As part of an upgrade - the first 4 columns need to stay the same, but each ID Number needs to be in its own row.
There might be other examples, gave up searching for a solution and created tihs.
Example:
12 0 www State ID123, ID222, ID333
13 1 wFw Fed ID454, ID88
Becomes:
12 0 www State ID123
12 0 www State ID222
12 0 www State ID333
13 1 wFw Fed ID454
13 1 wFw Fed ID88
NOTICE: the Split function is reported to work in Office 2000 and later VBA
http://msdn.microsoft.com/en-us/library/office/aa155763(v=office.10).aspx
As part of an upgrade - the first 4 columns need to stay the same, but each ID Number needs to be in its own row.
There might be other examples, gave up searching for a solution and created tihs.
Example:
12 0 www State ID123, ID222, ID333
13 1 wFw Fed ID454, ID88
Becomes:
12 0 www State ID123
12 0 www State ID222
12 0 www State ID333
13 1 wFw Fed ID454
13 1 wFw Fed ID88
Code:
Option Compare Database
Option Explicit
Public Sub SplitToRows()
'------------------------------------------------------------------
' Procedure : SplitToRows
' DateTime : 1/8/2013
' Author : Rx_
' Purpose : One field has comma delimited data - split them to multiple records
' Copy the primary table (Source) and delete all records - the copy becomes RsOut
' Replace the 1st.. 4th field names - data will remain the same for these fields
' Row 80 replace the field with the comma delimited data after the rsSource!
' Row 150 - on the rsout - add the name for the split
' in the Immediate window type then enter : SplitToRows
'------------------------------------------------------------------
10 On Error GoTo PROC_Error
Dim db As DAO.Database
Dim rsSource As DAO.Recordset
Dim rsOut As DAO.Recordset
Dim SplitToRows() As String
Dim i As Integer
20 Set db = CurrentDb
30 Set rsSource = db.OpenRecordset("QA_DirHorzA") ' source table
40 Set rsOut = db.OpenRecordset("QA_HorzSplit") ' copy of empty source table
50 If (Not rsSource.BOF And Not rsSource.EOF) Then
60 rsSource.MoveFirst
70 Do Until rsSource.EOF
80 SplitToRows = Split(rsSource!Dir_HzPass, ",", -1) ' comma - change to other delimiter here.
90 For i = LBound(SplitToRows()) To UBound(SplitToRows())
100 rsOut.AddNew
110 rsOut("ID_Wells") = rsSource("ID_Wells") ' Keep these the same
120 rsOut("CA_Req") = rsSource("CA_Req")
130 rsOut("CA NO") = rsSource("CA NO")
140 rsOut("Lease_Type") = rsSource("Lease_Type")
' Data was in one field - split by a comma
150 rsOut("Dir_HzPass") = SplitToRows(i) ' The field name that gets split based on a comma
160 rsOut.Update
170 Next i
180 rsSource.MoveNext
190 Loop
200 Else
210 MsgBox "No Records in Input"
220 End If
230 rsSource.Close
240 Set rsSource = Nothing
250 rsOut.Close
260 Set rsOut = Nothing
270 Set db = Nothing
PROC_Exit:
280 Exit Sub
PROC_Error:
290 'On Error GoTo 0 ' comment out 300 if no message box is needed
300 MsgBox "Error " & Err.Number & " (" & Err.Description & ") in splittoRows procedure"
310 On Error GoTo 0 ' clear error
Resume PROC_Exit:
End Sub
NOTICE: the Split function is reported to work in Office 2000 and later VBA
http://msdn.microsoft.com/en-us/library/office/aa155763(v=office.10).aspx