Conditional parsing, help please

[riaz]

I have a long list of accounts exported from my accounting software, which for reasons known to itself (it doesn't talk to me) lists the sub accounts in one long row with its parents, grandparents and all forefathers in one row. For example

6 · EXPENSES ACCOUNTS:67 · Tax on profit & loss:673 · Foreign income taxes:6732 · Taxes incurred by perm estabs:67322 · Prior years

This is just one account name. The government here has imposed this new accounting plan or chart of accounts on us, and I need to parse this depending on the level of the account number.

The dot, btw, is not a full stop, but CHAR(183), and the entire column is formatted as text.

What I need to do is to test if there is a number ending two characters after the last dot, work out how long it is and extract it into one column (67322), and the name following it (Prior years) into the next column. If there is no five digit number in that cell, I need to work backwards until I find a four digit number, and extract the number and the name that stops before the colon. If there is no four digit number, then I need to work backwards until I find a three digit number and do the same. Finally, if there is no three digit number, I need to find a two digit number which will always exist.

This is far too complicated for my feeble brain, so any help would be gratefully received. It has to be formula driven and not a macro if possible.

Many thanks
Riaz

 

[xenou]

Try this.
Save a backup;
Put this code in a standard module;
Edit the range address (in the code near the top) so it matches the sheet and range to be parsed;
Let er rip (run macro).

[COLOR="Navy"]Sub[/COLOR] Get_Accounts()
[COLOR="Navy"]Dim[/COLOR] a, i [COLOR="Navy"]As[/COLOR] Long, x [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] acct(1) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] re [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]
[COLOR="Navy"]Dim[/COLOR] r [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] Range

[COLOR="SeaGreen"]'---------------------------------------------------------------[/COLOR]
[COLOR="SeaGreen"]'Enter the Range to Parse - leave two empty columns to the right[/COLOR]
[COLOR="Navy"]Set[/COLOR] r = ActiveWorkbook.Worksheets("Sheet1").Range("$A$1:$A$10")
[COLOR="SeaGreen"]'---------------------------------------------------------------[/COLOR]

[COLOR="Navy"]Set[/COLOR] re = CreateObject("VBScript.RegExp")
[COLOR="Navy"]With[/COLOR] re
    .Pattern = ":[\d]*$"
    .MultiLine = False
    .Global = False
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] c [COLOR="Navy"]In[/COLOR] r
    [COLOR="Navy"]Erase[/COLOR] acct
    a = Empty
    a = Split(c.Value, Chr(183))
    [COLOR="Navy"]For[/COLOR] i = UBound(a) [COLOR="Navy"]To[/COLOR] 0 [COLOR="Navy"]Step[/COLOR] -1
        [COLOR="Navy"]With[/COLOR] re
            [COLOR="Navy"]If[/COLOR] .Test(Trim(a(i))) [COLOR="Navy"]Then[/COLOR]
                x = .Execute(Trim(a(i)))(0)
                acct(0) = Right(Trim(a(i)), Len(x) - 1)
                acct(1) = Trim(Replace(Trim(a(i)), x, ""))
                [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]For[/COLOR]
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    [COLOR="Navy"]Next[/COLOR] i
    c.Offset(0, 1).Value = acct(0)
    c.Offset(0, 2).Value = acct(1)
[COLOR="Navy"]Next[/COLOR] c


[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Fingers crossed...

 

[riaz]

Xenou, thanks, that was extremely quick.

The numbers are correctly found, but the name it is picking is the one before the number that is parsed, not the one after. My knowledge of macros is limited (read nonexistent!) but I will tinker with it to understand it and see if I can get the right bits picked up.

Many many thanks once again. The data is in about 1500 rows, and it was done in the blink of an eye.

 

[riaz]

SOLVED Re: Conditional parsing, help please

Changing

acct(1) = Trim(Replace(Trim(a(i)), x, ""))

to
acct(1) = Trim(Replace(Trim(a(i+1)), x, ""))

fixes that.

Thanks for all your help, you just saved me hours and hours.

Kind regards