Call function in Loop VBA - vba

Question

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

Answer 1

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

Answer 2

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).

Answer 3

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.