parse semicolon delimited

D

deb

Active Member
Joined
Feb 1, 2003
Messages
400
MS Access 2003

I have a table called tblHistory with the following fields...
HistRev MOrder HistNotes HistDate
with the below data rows. It is semicolon delimited.
I need to parse the records to a new table called tblDestination

HistRev
1;2;3
1;2

MOrder
abc123
xz123

HistNotes
Save;Submit;Cancel
Initiate;Save

HistDate
2009-06-22 01:41:16 PM;2010-06-23 02:31:16 PM;2010-08-22 04:41:16 PM
2010-06-23 02:31:16 PM;2010-08-22 04:41:16 PM


I need the new field records in tblDestination to look like


HistRev
1
2
3
1
2

MOrder
abc123
abc123
abc123
xz123
xz123

HistNotes
Save
Submit
Cancel
Initiate
Save

HistDate
2009-06-22 01:41:16 PM
2010-06-23 02:31:16 PM
2010-08-22 04:41:16 PM
2010-06-23 02:31:16 PM
2010-08-22 04:41:16 PM


Please, please help
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Sort by date Sort by votes
This may be a shot in the dark but give it a go (insert a new standard module and paste function in, then run it by hitting F5 with the cursor somewhere inside the code or on the first line). My assumption was that the MOrder number is always one and the same, and the other three fields will always have a matching number of elements that are semi-colon delimited - if that's not the case it's defunct.

Code: 
[COLOR="Navy"]Sub[/COLOR] Foo()
[COLOR="Navy"]Dim[/COLOR] rs(1) [COLOR="Navy"]As[/COLOR] DAO.Recordset
[COLOR="Navy"]Dim[/COLOR] a(3) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Variant[/COLOR]
[COLOR="Navy"]Dim[/COLOR] msg [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] ans [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] blnFlag [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Boolean[/COLOR]
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

    msg = "Please back up the database first! " & vbNewLine & "Continue now?"
    ans = MsgBox(msg, vbYesNo)
    [COLOR="Navy"]If[/COLOR] ans <> vbYes [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    
    [COLOR="Navy"]Set[/COLOR] rs(0) = CurrentDb.OpenRecordset("tblHistory", dbOpenTable)
    [COLOR="Navy"]Set[/COLOR] rs(1) = CurrentDb.OpenRecordset("tblDestination", dbOpenTable)
    
    [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] rs(0).EOF [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]With[/COLOR] rs(0)
            [COLOR="Navy"]Do[/COLOR] [COLOR="Navy"]While[/COLOR] [COLOR="Navy"]Not[/COLOR] .EOF
                a(0) = ![HistRev]
                a(1) = ![MOrder]
                a(2) = ![HistNotes]
                a(3) = ![HistDate]
                a(0) = Split(a(0), ";")
                a(2) = Split(a(2), ";")
                a(3) = Split(a(3), ";")
                
                blnFlag = False
                [COLOR="Navy"]If[/COLOR] UBound(a(0)) = UBound(a(2)) [COLOR="Navy"]And[/COLOR] UBound(a(0)) = UBound(a(3)) [COLOR="Navy"]Then[/COLOR]
                    blnFlag = True
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                
                [COLOR="Navy"]If[/COLOR] blnFlag [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]With[/COLOR] rs(1)
                        [COLOR="Navy"]For[/COLOR] i = 0 [COLOR="Navy"]To[/COLOR] UBound(a(0))
                            .AddNew
                            ![HistRev] = a(0)(i)
                            ![MOrder] = a(1)
                            ![HistNotes] = a(2)(i)
                            ![HistDate] = a(3)(i)
                            .Update
                        [COLOR="Navy"]Next[/COLOR] i
                    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
                [COLOR="Navy"]Else[/COLOR]
                    MsgBox "Error: HistRev, HistNotes, and HistDate do not have the same number of elements."
                    [COLOR="Navy"]GoTo[/COLOR] My_Exit
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                rs(0).MoveNext
            [COLOR="Navy"]Loop[/COLOR]
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

    rs(0).Close
    rs(1).Close
    [COLOR="Navy"]Set[/COLOR] rs(0) = [COLOR="Navy"]Nothing[/COLOR]
    [COLOR="Navy"]Set[/COLOR] rs(1) = [COLOR="Navy"]Nothing[/COLOR]
    
    MsgBox "Complete.  "

My_Exit:
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] i = 0 [COLOR="Navy"]To[/COLOR] 1
    [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] rs(i) [COLOR="Navy"]Is[/COLOR] [COLOR="Navy"]Nothing[/COLOR] [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] rs(i).EditMode [COLOR="Navy"]Then[/COLOR]
            rs(i).CancelUpdate
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
        rs(i).Close
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]Next[/COLOR] i
[COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
[COLOR="Navy"]Resume[/COLOR] My_Exit

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
 
Upvote 0
Actually being in accounting I have a great deal of concern for maintaining a history of where things came from - so here's a variation you could consider. I added two new fields to tblDestination. 1) a field called "AuditTrail" which holds the original data from tblHistory, and 2) a timestamp field called "DateModified" (maybe should be called DateLoaded or DateTransferred). I'm not sure how long your records get - so maybe it's not feasible to store the original tblHistory data (255 characters is the limit on an ordinary text field - memo would be needed if there could be more data). So this way if something went wrong you'd have something to look at that was the original record from tblHistory.

Also, since I'll be storing the original records, I don't need to abort if the number of elements aren't in synch - just skip the parsing but still store the original data for that one, and move on to the next.

Code: 
[COLOR="Navy"]Sub[/COLOR] Bar()
[COLOR="Navy"]Dim[/COLOR] rs(1) [COLOR="Navy"]As[/COLOR] DAO.Recordset
[COLOR="Navy"]Dim[/COLOR] a(4) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Variant[/COLOR]
[COLOR="Navy"]Dim[/COLOR] msg [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] ans [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] blnFlag [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Boolean[/COLOR]
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] dtmNow [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Date[/COLOR]

    msg = "Please back up the database first! " & vbNewLine & "Continue now?"
    ans = MsgBox(msg, vbYesNo)
    [COLOR="Navy"]If[/COLOR] ans <> vbYes [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    
    [COLOR="Navy"]Set[/COLOR] rs(0) = CurrentDb.OpenRecordset("tblHistory", dbOpenTable)
    [COLOR="Navy"]Set[/COLOR] rs(1) = CurrentDb.OpenRecordset("tblDestination", dbOpenTable)
    dtmNow = Now
    
    [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] rs(0).EOF [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]With[/COLOR] rs(0)
            [COLOR="Navy"]Do[/COLOR] [COLOR="Navy"]While[/COLOR] [COLOR="Navy"]Not[/COLOR] .EOF
                a(0) = ![HistRev]
                a(1) = ![MOrder]
                a(2) = ![HistNotes]
                a(3) = ![HistDate]
                a(4) = a(0) & "::" & a(1) & "::" & a(2) & "::" & a(3)
                a(0) = Split(a(0), ";")
                a(2) = Split(a(2), ";")
                a(3) = Split(a(3), ";")
                
                blnFlag = False
                [COLOR="Navy"]If[/COLOR] UBound(a(0)) = UBound(a(2)) [COLOR="Navy"]And[/COLOR] UBound(a(0)) = UBound(a(3)) [COLOR="Navy"]Then[/COLOR]
                    blnFlag = True
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                
                [COLOR="Navy"]With[/COLOR] rs(1)
                    [COLOR="Navy"]For[/COLOR] i = 0 [COLOR="Navy"]To[/COLOR] UBound(a(0))
                        .AddNew
                        [COLOR="Navy"]If[/COLOR] blnFlag [COLOR="Navy"]Then[/COLOR]
                            ![HistRev] = a(0)(i)
                            ![MOrder] = a(1)
                            ![HistNotes] = a(2)(i)
                            ![HistDate] = a(3)(i)
                        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                        ![AuditTrail] = a(4)
                        ![DateModified] = dtmNow
                        .Update
                    [COLOR="Navy"]Next[/COLOR] i
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
                
                rs(0).MoveNext
            [COLOR="Navy"]Loop[/COLOR]
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

    rs(0).Close
    rs(1).Close
    [COLOR="Navy"]Set[/COLOR] rs(0) = [COLOR="Navy"]Nothing[/COLOR]
    [COLOR="Navy"]Set[/COLOR] rs(1) = [COLOR="Navy"]Nothing[/COLOR]
    
    MsgBox "Complete.  "

My_Exit:
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] i = 0 [COLOR="Navy"]To[/COLOR] 1
    [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] rs(i) [COLOR="Navy"]Is[/COLOR] [COLOR="Navy"]Nothing[/COLOR] [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] rs(i).EditMode [COLOR="Navy"]Then[/COLOR]
            rs(i).CancelUpdate
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
        rs(i).Close
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]Next[/COLOR] i
[COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
[COLOR="Navy"]Resume[/COLOR] My_Exit

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
Help Please
2 3
Replies
21
Views
524
Asbestos_Jen
Asbestos_Jen
SFCChase
  • Question Question
Use Dropdown to search other tabs
Replies
4
Views
165
SFCChase
SFCChase
S
  • Solved
Average in excel
Replies
3
Views
256
etaf
etaf
R
  • Solved
Age Group Ranging by gender
Replies
2
Views
274
Raj1979
R
N
  • Question Question
Advisor login, logout & break calculation
Replies
1
Views
253
Cubist
Cubist

Forum statistics

Threads
1,224,600
Messages
6,179,836
Members
452,947
Latest member
Gerry_F

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top