|
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 |
|
hi, Why would this m06_05a1 m08_15d4 m08_15a3 s08_9c2 m17_09d3
not be s08_ 09c2 Skip,
Just traded in my old subtlety... for a NUANCE! |
|
here's a first shot, using testit as a function right on the worksheet... CODEFunction 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! |
|
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 |
|
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.
|
|
Quote: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 |
|
Modify testit as posted... CODE 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 = testit & Format(sOUT, "00") & Right(s, Len(s) - i + 1) End Function
Skip,
Just traded in my old subtlety... for a NUANCE! |
|
Thanks alot Skip the new version worked like a charm. I made one modification to force the alpha characters to lower case. CODEFunction 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 = LCase(testit & Format(sOUT, "00") & Right(s, Len(s) - i + 1)) End Function thanks so much for your efforts |
|
|
 |