Excellent split cell based on words

I have a excel sheet
There is 1 cell that I need to split up

I need a macro that can be used to split into multiple columns

A sample cell would be :
Name: bob address: 555  street Tel number:  555 666 7777 State: al

Here are the words

Name:
Address:
Tel number:
State:


Any help would be much appreciated
neoptoentAsked:
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.

Martin LissOlder than dirtCommented:
This assumes the data is in A1. I didn't know what you wanted to do with the results so I just put in MagBoxes.
Sub SplitCell()
Dim strName As String
Dim strAddress As String
Dim strTelNumber As String
Dim strState As String
Dim intPos As Integer
Dim intOldPos As Integer

'Name: bob address: 555  street Tel number:  555 666 7777 State: al
With Range("A1")
    intPos = InStrRev(.Value, ":")
    strState = LTrim(Mid$(.Value, intPos + 1))
    intOldPos = intPos
    
    intPos = InStrRev(.Value, ":", intPos - 1)
    strTelNumber = LTrim(Mid$(.Value, intPos + 1, intOldPos - intPos - Len("State:")))
    intOldPos = intPos
    
    intPos = InStrRev(.Value, ":", intPos - 1)
    strAddress = LTrim(Mid$(.Value, intPos + 1, intOldPos - intPos - Len("Tel number:")))
    intOldPos = intPos
    
    intPos = InStrRev(.Value, ":", intPos - 1)
    strName = LTrim(Mid$(.Value, intPos + 1, intOldPos - intPos - Len("address:")))
    
    MsgBox strName
    MsgBox strAddress
    MsgBox strTelNumber
    MsgBox strState
 
End With

End Sub

Open in new window

0
rspahitzCommented:
I could certainly help you do this as a macro, but you can also do this with formulas (which tend to be safer--less prone to error):

Assuming the above is in a1:
="Name: bob address: 555  street Tel number:  555 666 7777 State: al"

I'd create a few columns of "interim" results:
B1=FIND("Address:", A1)
C1=FIND("Tel Number:", A1)
D1=FIND("State:", A1)

Now you know where the parts are and you can "parse" out the data:
E1=MID(A1, 1, B1 - 1)
F1=MID(A1, B1, C1 - B1 -1)
G1=MID(A1, C1, D1 - C1 - 1)
H1=MID(A1, D1, 999)

E1 will give you: Name: bob
F1 will give you Address: 555 street
etc.
If you want to exclude the prefix, you can adjust based on the length of the prefix such as:
E1=MID(A1, 6, B1 - 6)
since the data starts at position 6.
You may also want to TRIM() the end results.

Does this help or do you really want VBA/macro?
0
neoptoentAuthor Commented:
Hi,

Thanks for the quick reply.
I need a macro so it can be used with multiple spreadsheets.
Can this put the content in following cells instead on messagebox.
Also it need to do it for all rows in the sheet
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

regmigrantCommented:
just for kicks - see attached
fielding.xlsx
0
Martin LissOlder than dirtCommented:
Assumes the data is in column A. If not then change the "A" in lines 10 and 11 to match the actual column.
Sub SplitCell()
Dim strName As String
Dim strAddress As String
Dim strTelNumber As String
Dim strState As String
Dim intPos As Integer
Dim intOldPos As Integer
Dim lngRow As Long

For lngRow = 1 To ActiveSheet.Range("A1048576").End(xlUp).Row
    With Cells(lngRow, "A")
        intPos = InStrRev(.Value, ":")
        strState = LTrim(Mid$(.Value, intPos + 1))
        intOldPos = intPos
        
        intPos = InStrRev(.Value, ":", intPos - 1)
        strTelNumber = LTrim(Mid$(.Value, intPos + 1, intOldPos - intPos - Len("State:")))
        intOldPos = intPos
        
        intPos = InStrRev(.Value, ":", intPos - 1)
        strAddress = LTrim(Mid$(.Value, intPos + 1, intOldPos - intPos - Len("Tel number:")))
        intOldPos = intPos
        
        intPos = InStrRev(.Value, ":", intPos - 1)
        strName = LTrim(Mid$(.Value, intPos + 1, intOldPos - intPos - Len("address:")))
        .Offset(0, 1) = strName
        .Offset(0, 2) = strAddress
        .Offset(0, 3) = strTelNumber
        .Offset(0, 4) = strState
 
    End With
Next
End Sub

Open in new window

0
neoptoentAuthor Commented:
is some cells have more fields than others
some have "country" or "other"
is it possible to have this macro automatically include them also?
0
aikimarkCommented:
1. clean the data
ReplaceAll "Name: ", "" 
ReplaceAll "Address: ", "|"
ReplaceAll "Tel number: ", "|"
ReplaceAll "State: ", "|"

2. Text to Columns based on pipe character (|) delimiter
0
neoptoentAuthor Commented:
Thanks for the assistance
In some of the field there are commas or / and it seems to mess the fields or errors out.
0
aikimarkCommented:
please post a representative sample of the data.
0
neoptoentAuthor Commented:
some have address like 45, 75 street
or 37/84 road or even .


don't have sample
0
Martin LissOlder than dirtCommented:
Try this. arrFields needs to contain all the possible field names.
Sub SplitCells()
Dim intPos As Integer
Dim intPosNext As Integer
Dim lngRow As Long
Dim intField As Integer
Dim bSkipped As Boolean
Dim intNext As Integer
Dim arrFields

arrFields = Array("Name:", "address:", "Tel number:", "State:", "Country:")

For lngRow = 1 To ActiveSheet.Range("A1048576").End(xlUp).Row
    For intField = 0 To UBound(arrFields)
        ' See if the arrField is in the cell
        intPos = InStr(1, UCase(Cells(lngRow, "A").Value), UCase(arrFields(intField)))
        If intPos > 0 Then
            ' it is so find the next one so we can isolate the text in the cell
            If intField = UBound(arrFields) Then
                Cells(lngRow, "A").Offset(0, intField + 1) = Mid$(Cells(lngRow, "A").Value, intPos + Len(arrFields(intField)))
                Exit For
            End If
            intPosNext = InStr(intPos + 1, UCase(Cells(lngRow, "A").Value), UCase(arrFields(intField + 1)))
            If intPosNext > 0 Then
                Cells(lngRow, "A").Offset(0, intField + 1) = Mid$(Cells(lngRow, "A").Value, intPos + Len(arrFields(intField)), intPosNext - intPos - Len(arrFields(intField)))
            Else
                ' Find the next field after the current one in the data
                bSkipped = False
                For intNext = intField + 1 To UBound(arrFields)
                    If InStr(1, UCase(Cells(lngRow, "A").Value), UCase(arrFields(intNext))) > 0 Then
                        intPosNext = InStr(intPos + 1, UCase(Cells(lngRow, "A").Value), UCase(arrFields(intNext)))
                        Cells(lngRow, "A").Offset(0, intField + 1) = Mid$(Cells(lngRow, "A").Value, intPos + Len(arrFields(intField)), intPosNext - intPos - Len(arrFields(intField)))
                        bSkipped = True
                        Exit For
                    End If
                Next
                If Not bSkipped Then
                    Cells(lngRow, "A").Offset(0, intField + 1) = Mid$(Cells(lngRow, "A").Value, intPos + Len(arrFields(intField)))
                End If
            End If
        End If
    Next
Next

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
Martin LissOlder than dirtCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
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.