CODEWITHSUNDEEP
vbaexcelexcel-2010
MrsAdmin
MrsAdmin

Reputation: 548

EXCEL 2010: Split Cells using VBA to multiple Cells

I am looking for some help converting my formulas to VBA code.

My data is currently in Column ($T10)

I currently have rows of data similar to:
Jane Doe (doe.jane@___.com)
JOHN DOE, SR (noemail-8858)
first second DE surname surname2 (email@_______.com)
first middle surname (email@_____.net)

Formulas to get the 'normal' names:

[First Surname]  =IF($C2678=1,(LEFT(B2684,SEARCH("(",B2684)-1)),"")    
[first name]     =IF($C4068=1,(LEFT(TRIM(B4074),FIND(" ",TRIM(B4074))-1)),"")
[middle name]    =IF($C3888=1,(IF(LEN(TRIM(B3894))-LEN(SUBSTITUTE(B3894," ",""))<>3,"",LEFT(MID(TRIM(B3894),FIND(" ",TRIM(B3894))+1,99),FIND(" ",MID(TRIM(B3894),FIND(" ",TRIM(B3894))+1,99))-1))),"")
[surname]        =IF($C4068=1,(TRIM(RIGHT(SUBSTITUTE(TRIM(LEFT(B4074,FIND("(",B4074)-1))," ",REPT(" ",99)),99))),"")  
[email]          =IF($C4068=1,(MID(TRIM(B4074),FIND("(",TRIM(B4074))+1,FIND(")",TRIM(B4074))-FIND("(",TRIM(B4074))-1)),"")

Results (edited): 

|  jane Doe       |  jane   |  middle  |  Doe      |  doe.jane@____.com  |    
|  first surname  |  first  |  middle  |  Surname  |  noemail-8858       |

I've looked at both TRIM and SPLIT functions, however I haven't been able to find a way to split given the variables (, ( )) in the one cell.

I've used:
http://www.homeandlearn.org/left_and_right_functions.html

http://www.globaliconnect.com/excel/index.php?option=com_content&view=article&id=269:excel-vba-string-functions-left-right-mid-len-replace-instr-instrrev&catid=79&Itemid=475

http://www.exceltrick.com/formulas_macros/vba-split-function/

They aren't really piecing together what I need. I can get some basics, but not the more complex formulas converted to VBA.

Many thanks in advance.

This is an extension of my previous enquiry in 2014, where I was able to get the formulas.
Excel 2010 search for text in IF function - separate cell data

Upvotes: 1

Views: 450

Answers (1)

Simon
Simon

Reputation: 577

Short of analysing exactly what your formulas are currently doing (i assume you're happy with how they work right?) then I can't see why you can't directly convert them all?

Start point:

=IF($C3888=1,(IF(LEN(TRIM(B3894))-LEN(SUBSTITUTE(B3894," ",""))<>3,"",LEFT(MID(TRIM(B3894),FIND(" ",TRIM(B3894))+1,99),FIND(" ",MID(TRIM(B3894),FIND(" ",TRIM(B3894))+1,99))-1))),"")

Formatted more:

=IF($C3888=1,
   (IF(LEN(TRIM(B3894))-LEN(SUBSTITUTE(B3894," ","")) <>3,
      "",
      LEFT(
         MID(
           TRIM(B3894),
           FIND(
              " ",
              TRIM(B3894)
           ) +1,
           99
         ),
         FIND(
            " ",
            MID(
               TRIM(B3894),
               FIND(
                   " ",
                   TRIM(B3894)
               )+1,
               99
            )
          )-1
         )
       )
      )
   ,"")

I think you've got a few too many Mids and Lefts than you need. This is how I've interpreted "Get the word between the first and second spaces of the trimmed value"... Is that right?

VBA-afied:

Function GetMiddleName(rgName As Range) As String
    Dim intTrimmed As Integer
    Dim intNoSpace As Integer
    Dim stTrimmed As String

    Dim intFirstSpace As Integer
    Dim intSecondSpace As Integer

    If rgName.Offset(-6, 1).Value = 1 Then ' This gives the "C3888" from the "B3894"
        stTrimmed = Trim(rgName.Value)
        intTrimmed = Len(stTrimmed)
        intNoSpace = Len(Replace(rgName.Value, " ", ""))

        If intTrimmed - intNoSpace <> 3 Then
            GetMiddleName = ""
            Exit Function
        Else
            intFirstSpace = InStr(1, stTrimmed, " ")
            intSecondSpace = InStr(intFirstSpace + 1, stTrimmed, " ")

            GetMiddleName = Mid(stTrimmed, intFirstSpace + 1, intSecondSpace - (intFirstSpace + 1))
            Exit Function
        End If
    Else
        GetMiddleName = ""
    End If
End Function

Hopefully that gets you started with some ideas for the other formulas... PS the "rept" formula = "string" in VBA (I didn't know there was a rept formula! Nice one!)

That gives me these results:

"Jane Doe (doe.jane@___.com)" = "" (fails the "len - nospaces <> 3" check)
"JOHN DOE, SR (noemail-8858)" = "DOE," (might wanna add a Replace(","...) )
"first second DE surname surname2 (email@_______.com)" = "" (fails the "<>3" check) 
"first middle surname (email@_____.net)" = "middle" Works Swimingly?

Upvotes: 2

Related Questions