Macro or function 1

[sterlecki]

I have created a rather complex formula to parse out some text data into a specific format. I would like to be able to store this as a function and/or be able to apply this formula as a macro to a long list using a FOR EACH...NEXT statement.

How can I save this formula as either a function or a macro that would allow me to desginate the data cell (A2 in this example) and apply it to any cell I designate?

the following is a concatenation of 3 formulas and one text character


=LOWER(LEFT(A2,1) &
IF(OR(MID(A2,FIND("-",A2)+1,1)="1",MID(A2,FIND("-",A2)+1,1)="2",MID(A2,FIND("-",A2)+1,1)="3"),MID(A2,FIND("-",A2)+1,2),CONCATENATE("0",MID(A2,FIND("-",A2)+1,1))))&
"_"&
LOWER(IF(MID(A2,FIND("-",A2)-4,1)=" ",CONCATENATE("0",MID(A2,FIND("-",A2)-3,3)),MID(A2,FIND("-",A2)-4,4)))

The data looks like this:

mesa unit 5a1-6d
Mesa 15D4-8
Mesa Unit 15A3-8
Stewart Point 9C2-8
Mesa 9D3-17

Results Look like this:

m06_05a1
m08_15d4
m08_15a3
s08_9c2
m17_09d3

Perhaps I need both a function and then I can apply that function as a macro to any column I choose.

thanks

 

[SkipVought]

hi,

Why would [highlight]this[/highlight]
[tt]
m06_05a1
m08_15d4
m08_15a3[highlight]
s08_9c2[/highlight]
m17_09d3
[/tt]
not be s08_[highlight]0[/highlight]9c2


Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

here's a first shot, using testit as a function right on the worksheet...

Function testit(rng As Range) As String
    Dim a
    
    a = Split(rng, " ")
    
    testit = Left(a(0), 1)
    
    testit = testit & Format(RemAlpha(CStr(Split(a(UBound(a)), "-")(1))), "00") & "_" & Split(a(UBound(a)), "-")(0)
End Function
Function RemAlpha(strS As String)
':remove ALPHA from a string
     Dim re As Object ' object to hold Regular Expression object
    
     Set re = CreateObject("VBScript.RegExp") ' late bind to RegExp object so no need to reference in application
    
     With re
         .Global = True ' find all matches not just first
         .MultiLine = True ' over multiple lines
         .IgnoreCase = True ' whether upper or lower case (more relevant for alpha char matching)
         .Pattern = "[A-Z]" ' regular expression for numeric range
         RemAlpha = .Replace(strS, "") ' set return value to value of strS where everything matched by the pattern is replaced with ""
     End With
  
 End Function

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[N1GHTEYES]

If you want to be able to apply the formula to any cell from any cell, then you'll need to follow Skip's example and create a function in VBA.

However, if you're happy for the output always to be, say, one cell to the right of the input cell (or any other fixed positional relationship), you could simply name the formula. In other words, put the formula in cell B2, and copy the text of the formula to the clipboard. The click "Insert", "Name", "Define" via the menu, and in the dialog box, call it MyFunc (or whatever you want) and paste the function into the formula bar of the dialog box, and save it.

Then, if you type "= MyFunc" into cell B3, it will apply the function to cell A3.

Tony

 

[sterlecki]

Skip and Tony thanks for your input and sorry about the late reply.

Tony

I tried saving the formula. Didn't know that was possible.
Can named formulas be accessible from other workbooks similar to the personal macro workbook? If I could do that I can think of alot of utilities that I use that would work. Being tied down to one workbook is not an option for me.

Skip

Your function is very close but I have to admit the code is over my head for a quick understanding. You were correct in your first reply that s08_9c2 should have read s08_09c2

I tried your code and it produced the following results:

Input Results Testit() Proper Results
mesa unit 5a1-6d m06_5a1 m06_05a1
Mesa 15D4-8 M08_15D4 m08_15d4
Mesa 15A3-8 M08_15A3 m08_15a3
Stewart Point 9C2-8 S08_9C2 s08_09c2
Mesa 9D3-17 M17_9D3 m17_09d3

The leading zero is missing for the number to the right of the underscore.

The convention calls for all lower case alphas and leading zeros for single digit integers immediately on either side of the underscore. The purpose is the ability to sort by letter (m or s)
by digits 2 and 3 (range of 1-36) then after the underscore digits 5 and 6 (range 1-16) the final digit (range 1-4) does not require a leading zero as it sorts already.

I will attempt to modify your code but any further help would be greatly appreciated.

 

[N1GHTEYES]

Can named formulas be accessible from other workbooks similar to the personal macro workbook

I'm not sure. I never use personal.xls. However, I think it should work. Try it and see.

Tony

 

[SkipVought]

Modify testit as posted...

Function testit(rng As Range)
    Dim a, s As String, byt As String, i As Integer, sOUT As String
    
    a = Split(rng, " ")
    
    testit = Left(a(0), 1)
    
    s = Split(a(UBound(a)), "-")(0)
 [b]
    testit = testit & Format(RemAlpha(CStr(Split(a(UBound(a)), "-")(1))), "00") & "_"
    
    For i = 1 To Len(s)
        byt = Mid(s, i, 1)
    
        Select Case byt
            Case "0" To "9"
                sOUT = sOUT & byt
            Case Else
                Exit For
        End Select
    Next
    
    testit = testit & Format(sOUT, "00") & Right(s, Len(s) - i + 1)[/b]
End Function

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[sterlecki]

Thanks alot Skip the new version worked like a charm. I made one modification to force the alpha characters to lower case.

Function testit(rng As Range)
    Dim a, s As String, byt As String, i As Integer, sOUT As String
        a = Split(rng, " ")
        testit = Left(a(0), 1)
        s = Split(a(UBound(a)), "-")(0)
     testit = testit & Format(RemAlpha(CStr(Split(a(UBound(a)), "-")(1))), "00") & "_"
        For i = 1 To Len(s)
        byt = Mid(s, i, 1)
            Select Case byt
            Case "0" To "9" 
               sOUT = sOUT & byt  
          Case Else          
      Exit For      
  End Select   
 Next 
       testit = [highlight]LCase[/highlight](testit & Format(sOUT, "00") & Right(s, Len(s) - i + 1))
End Function

thanks so much for your efforts