Problems splitting a text & number string using VBA

**Tamor** · 09-22-2009, 07:42 AM

I've done some basic VBA regarding excel spreadsheets in the past, but I'm having trouble with a recent problem. I need to split a string of text & numbers in a coloum into a few different cells.

I've done some extensive searching on google, and come across a few similar problems and solutions, but I am struggling to apply it to my situation.

I currently have a few large spreadsheets 7 coloums by a few hundred. Blank columns in B & E-I. Column D contains the text string I need to split. It looks like this

1234567:ABXY0000.Text with spaces - Fee.Surname.Forename.000000

I need to split the text string after AB, before the 'Text with spaces', delete the word ' - Fee', the Surname.Forename changing the "." to a ", " and split the last 000000, which is a reference number that can vary in length.

Column: Contents
D: 1234567:AB
E: XY0000
F: Text with spaces
G: Surname, Forename or Surname Forename
I: 000000

I need to remove all the full stops except the one between the forename & surname, though a space would surfice, delete a part of the text string and split it from 1 column to 5.

**Andy Pope** · 09-22-2009, 08:26 AM

Something like this maybe. Does D1 only. If correct it would need a loop to do all values in column D

Sub X()
    
    Dim strText As String
    Dim lngPos As Long
    
    strText = Range("D1").Value
    lngPos = InStr(strText, ":") + 2
    Range("D1") = Left(strText, lngPos)
    strText = Mid(strText, lngPos + 1)
    
    lngPos = InStr(strText, ".")
    Range("E1") = Left(strText, lngPos - 1)
    strText = Mid(strText, lngPos + 1)
    
    lngPos = InStr(strText, "- Fee")
    Range("F1") = Left(strText, lngPos - 1)
    strText = Mid(strText, lngPos + 6)
    
    lngPos = InStrRev(strText, ".")
    Range("G1") = Replace(Left(strText, lngPos - 1), ".", ",")
    Range("I1") = Mid(strText, lngPos + 1)
    
End Sub

**lecxe** · 09-22-2009, 11:03 AM

Hi

Another option. Please test for cell D1, if it works loop through the others.
If it doesn't work, please post some examples with real data:

Sub SplitText()
Dim rC As Range

Set rC = Range("D1")
With CreateObject("VBScript.RegExp")
    .Pattern = "(.*?:.{2})(.+?)\.(.*?)\s*-\s*Fee\.(.+?)\.(.+?)\.(\d+)"
    rC.Resize(, 5) = Split(.Replace(rC, "$1#$2#$3#$4, $5#$6"), "#")
End With
End Sub