1

My problem is simple for VBA pro. if you can help me to understand please. I am trying to call a function which keep only caps in a cell and past the result in the next column by looping all the rows. Please take a look at the code below. Thank you.

Option Explicit
Sub LLOP()
Dim i As Integer
i = 1
Do While Cells(i, 10).Value <> ""
Cells(i, 11).Value = Cells(i, 10).Value = ExtractCap
i = i + 1
Loop

End Sub


Option Explicit

Function ExtractCap(Txt As String) As String

Application.Volatile
Dim xRegEx As Object
Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
xRegEx.Pattern = "[^A-Z]"
xRegEx.Global = True
ExtractCap = xRegEx.Replace(Txt, "")
Set xRegEx = Nothing

End Function
3
  • 2
    what's the problem? Commented Mar 26, 2018 at 9:15
  • 1
    Are you sure this code is right? You have Option Explicit twice, and also, this line Cells(i, 11).Value = Cells(i, 10).Value = ExtractCap makes no sense Commented Mar 26, 2018 at 9:19
  • This looks wrong on many levels - Cells(i, 11).Value = Cells(i, 10).Value = ExtractCap Commented Mar 26, 2018 at 9:20

3 Answers 3

2

Try something like as follows. Notes to follow.

1) Extract cap requires an argument which is the string you want to replace. I have used the value in the adjacent column

2) Option Explicit should only occur once at the top of the module

3) As you are looping rows uses Long not Integer to avoid potential overflow

4) Comparison with vbNullString is faster than empty string literal ""

Edit:

5) See @Jeeped's comment re Static xRegEx As Object followed by if xregex is nothing then Set xRegEx = CreateObject("VBSCRIPT.REGEXP") which significantly improves performance when called in a loop as the regex object only gets created once

Option Explicit
Sub LLOP()

    Dim i As Long
    i = 1

    With ThisWorkbook.Worksheets("Sheet1") 'change as appropriate

    Do While .Cells(i, 10).Value <> vbNullString 'column J
        .Cells(i, 11).Value = ExtractCap(.Cells(i, 10).Text) 'column K
        i = i + 1
    Loop

    End With

End Sub


Public Function ExtractCap(Txt As String) As String

    Application.Volatile
    Dim xRegEx As Object
    Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
    xRegEx.Pattern = "[^A-Z]"
    xRegEx.Global = True
    ExtractCap = xRegEx.Replace(Txt, vbNullString)

End Function
Sign up to request clarification or add additional context in comments.

4 Comments

To be honest, I feel guilty as after finishing typing mine it looks very similar to yours :-( but I was typing up my own!
Don't feel guilty :) , it is a bit different - mine is working with the function as a built in Excel formula and yours is calculating the result and printing it.
I'm guessing technically I can do ExtractCap = xRegEx.Replace(Txt, vbNullString) as well? It will be a faster assignment.
It will definitely not be slower. But the "" is 6 bytes, in a computer made this century the speed advantage should not be visible/noticeable.
1

Assuming that you want to enter a custom =ExtractCap() formula in the 11. column, with a parameter of the 10. column, this is a possible solution:

Option Explicit

Sub LLOP()

    Dim i As Long: i = 1
    Do While Cells(i, 10).Value <> ""
        Cells(i, 11).Formula = "=ExtractCap(""" & Cells(i, 10) & """)"
        i = i + 1
    Loop
End Sub

Function ExtractCap(Txt As String) As String

    Application.Volatile
    Static xRegEx As Object
    If xRegEx Is Nothing Then Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
    xRegEx.Pattern = "[^A-Z]"
    xRegEx.Global = True
    ExtractCap = xRegEx.Replace(Txt, "")

End Function

The .Formula passes the function ExtractCap as a formula with its parameter of Cells(i, 10).

4 Comments

fwiw, I've found that Static xRegEx As Object followed by if xregex is nothing then Set xRegEx = CreateObject("VBSCRIPT.REGEXP") significantly improves performance when called in a loop as the regex object only gets created once,
@Jeeped - it is a good idea indeed if we are looping once and forgetting about it. In the solution above it is a Application.Volatile option, thus the solution is considered to be working independently once it is written in Excel.
In a loop or filled down a column doesn't matter; any repetitious use will benefit from a static object.
@Jeeped - I see what you mean now. I was thinking of passing the xRegEx as a parameter in the loop.
0

Try below alternative code. Your method is complicated and uses regular expressions (which is nice, but in your case, ineffective).

The code:

Option Explicit
Sub LLOP()
Dim i As Integer
i = 1

'indentation! in your original code, you didn't have proper indentation
'I know that VBA editor don't indent code automatically, but it's worth the effort
Do While Cells(i, 10).Value <> ""
    ' invalid syntax!
    ' first, this is kind of multiple assignment (I don't know what are you trying to do)
    ' secondly, you call your function without arguments
    ' Cells(i, 11).Value = Cells(i, 10).Value = ExtractCap
    ' I guess you wanted something like this
    Cells(i, 11).Value = ExtractCap(Cells(i, 10).Value)
    'or using my function:
    Cells(i, 11).Value = SimpleExtractCap(Cells(i, 10).Value)
    i = i + 1
Loop

End Sub

'THIS IS YOUR FUNCTION, which is complicated (unnecessarily)
Function ExtractCap(Txt As String) As String

Application.Volatile
Dim xRegEx As Object
Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
xRegEx.Pattern = "[^A-Z]"
xRegEx.Global = True
ExtractCap = xRegEx.Replace(Txt, "")
Set xRegEx = Nothing

End Function

'this is my alternative to your function, which is very simple and basic
Function SimpleExtractCap(Txt As String) As String
SimpleExtractCap = ""
Dim i As Long, char As String
For i = 1 To Len(Txt)
    char = Mid(Txt, i, 1)
    'if we have upper-case letter, then append it to the result
    If isLetter(char) And char = UCase(char) Then
        SimpleExtractCap = SimpleExtractCap & char
    End If
Next
End Function

Edit:

In order to check if given character is letter, you'll need additional function:

Function isLetter(letter As String) As Boolean
Dim upper As String
upper = UCase(letter)
isletter = Asc(upper) > 64 And Asc(upper) < 91
End Function

Now, I added this function to code, to check if character is letter.

1 Comment

Thanks for your contribution. Indeed you function is much more rapid to display. However it gives not only caps but some numbers between caps.Thank you

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.