Split Cell into Four Columns, Based on Two Criteria

Hello Experts,

I would like to request your help in writing a vba code that will split all cells in a selected range, based on the following criteria (Please refer to Excel attachment for all column references):

1.

Find the last instance of the character ":" (colon) for each cell in column B and split into two columns. (If no colon found, copy and paste full cell string into column C

2.

Split Column D (text to column) by using the character "-" (hyphen) as the delimiter
Ultimately the columns that will be useful for my purposes will be D, and F, which are the account number and account description.  Down the road I will need to figure out how to delete column E, since I won't need, but I can try to figure that part out later on.

Thank you very much for any help you can provide.

Book1.xlsx
SuraDalbinAccountantAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saurabh Singh TeotiaCommented:
Quick question are you open to do this by formulas or you want to do this by macro only???

Saurabh...
0
SuraDalbinAccountantAuthor Commented:
I would prefer to do by macro, since I'd like to add to my personal ribbon list of macros.

Thanks Saurabh
0
Saurabh Singh TeotiaCommented:
Use this code...

Sub getvalues()
    Dim cell As Range, rng As Range
    Dim lrow As Long, k As Long

    lrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row

    Set rng = Range("B2:B" & lrow)

    For Each cell In rng

        If Len(cell.Value) - Len(Replace(cell.Value, "-", "")) > 1 Then
            cell.Offset(0, 1).Value = Left(cell.Value, InStrRev(cell.Value, ":"))
            cell.Offset(0, 2).Value = Mid(cell.Value, InStrRev(cell.Value, ":", -1, vbTextCompare) + 1, InStrRev(cell.Value, "-", -1, vbTextCompare) - InStrRev(cell.Value, ":", -1, vbTextCompare) - 1)
            cell.Offset(0, 3).Value = "-"
            cell.Offset(0, 4).Value = Right(cell.Value, Len(cell.Value) - InStrRev(cell.Value, "-", -1, vbTextCompare) - 1)
        Else
            cell.Offset(0, 1).Value = cell.Value
            cell.Offset(0, 2).Value = Left(cell.Value, InStr(1, cell.Value, "-", vbTextCompare) - 1)
            cell.Offset(0, 3).Value = "-"
            cell.Offset(0, 4).Value = Right(cell.Value, Len(cell.Value) - InStrRev(cell.Value, "-", -1, vbTextCompare))

        End If



    Next cell


End Sub

Open in new window


Saurabh...
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

SuraDalbinAccountantAuthor Commented:
Hello Saurabh,

This works like a charm!

I have an additional question, and this is completely my fault for not providing the entire range of cells to be splitted, but how can we get around the following:

16000- Property, Plant & Equip:16100- Computing and Commun.:16150- Telephone System - SD

If you'll notice, in this account description, there is an additional "-" (hyphen), after the last occurrence of the ":" delimiter.  So currently, the code splits this account description as follows:
Split2.PNG
If you'd like me to create a second question to award additional points, by all means, please let me know.
0
Saurabh Singh TeotiaCommented:
Try using this...

Sub getvalues()
    Dim cell As Range, rng As Range
    Dim lrow As Long, k As Long

    lrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row

    Set rng = Range("B2:B" & lrow)

    For Each cell In rng

        If Len(cell.Value) - Len(Replace(cell.Value, "-", "")) > 1 Then
            cell.Offset(0, 1).Value = Left(cell.Value, InStrRev(cell.Value, ":"))
cell.Offset(0, 2).Value = Mid(cell.Value, InStrRev(cell.Value, ":", -1, vbTextCompare) + 1, 5)
            cell.Offset(0, 3).Value = "-"
            cell.Offset(0, 4).Value = Right(cell.Value, Len(cell.Value) - InStrRev(cell.Value, ":", -1, vbTextCompare) - 7)
        Else
            cell.Offset(0, 1).Value = cell.Value
            cell.Offset(0, 2).Value = Left(cell.Value, InStr(1, cell.Value, "-", vbTextCompare) - 1)
            cell.Offset(0, 3).Value = "-"
            cell.Offset(0, 4).Value = Right(cell.Value, Len(cell.Value) - InStrRev(cell.Value, "-", -1, vbTextCompare))

        End If



    Next cell


End Sub

Open in new window


Saurabh...
0
Saurabh Singh TeotiaCommented:
Also have assumed in the above code that your characters post : will be 5 digits..please let me know if thats not the case...as i made further dyanmic irrespective what the length is..

Sub getvalues()
    Dim cell As Range, rng As Range
    Dim lrow As Long, k As Long

    lrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row

    Set rng = Range("B2:B" & lrow)

    For Each cell In rng

        If Len(cell.Value) - Len(Replace(cell.Value, "-", "")) > 1 Then
            cell.Offset(0, 1).Value = Left(cell.Value, InStrRev(cell.Value, ":"))
            cell.Offset(0, 2).Value = Mid(cell.Value, InStrRev(cell.Value, ":", -1, vbTextCompare) + 1, InStr(InStrRev(cell.Value, ":", -1, vbTextCompare) + 1, cell.Value, "-", vbTextCompare) - InStrRev(cell.Value, ":", -1, vbTextCompare) - 1)
            cell.Offset(0, 3).Value = "-"
            cell.Offset(0, 4).Value = Right(cell.Value, Len(cell.Value) - InStr(InStrRev(cell.Value, ":", -1, vbTextCompare) + 1, cell.Value, "-", vbTextCompare) - 1)
        Else
            cell.Offset(0, 1).Value = cell.Value
            cell.Offset(0, 2).Value = Left(cell.Value, InStr(1, cell.Value, "-", vbTextCompare) - 1)
            cell.Offset(0, 3).Value = "-"
            cell.Offset(0, 4).Value = Right(cell.Value, Len(cell.Value) - InStrRev(cell.Value, "-", -1, vbTextCompare))

        End If



    Next cell


End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
SuraDalbinAccountantAuthor Commented:
Hello Saurabh,

This definitely works better.  One last question, and if it's too much to ask, then I could definitely work with this solution you've provided.

Split3.PNG
Would it be possible to leave just the account number in the highlighted cell?

Everything else, works perfectly.

Thank you
0
Saurabh Singh TeotiaCommented:
I have revised the codes which i gave to you..run them and you will find only account number in them provided you have ":" in your dataset..you can run both of them as i made some changes later on to make them more dynamic...
0
SuraDalbinAccountantAuthor Commented:
Thank you very much Saurabh, this works perfectly!!!
0
Saurabh Singh TeotiaCommented:
Yw...Happy to help... :-)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.