I have been trying to make a user defined function I wrote return it's value in all upper case, using the String.ToUpper() method in VBA. When I try to use my UDF in excel, I get a compiler error that just highlights the top line of my UDF:
Function removeSpecial(sInput As String) As String
Here is the code in it's entirety:
Function removeSpecial(sInput As String) As String
Dim sSpecialChars As String
Dim i As Long
sSpecialChars = "\/:*?™""®<>|.&## (_+`©~);-+=^$!,'" 'This is your list of characters to be removed
For i = 1 To Len(sSpecialChars)
sInput = Replace$(sInput, Mid$(sSpecialChars, i, 1), "")
Next
sInput = sInput.ToUpper()
removeSpecial = sInput
End Function
The code works fine to remove special characters, but I would like it to also convert the inputted String to upper case.
I started receiving this error when I tried to add:
sInput = sInput.ToUpper()
If this code is commented out, my UDF works, but without returning the inputted string in all Upper.
Just the wrong function. You want
sInput = UCase(sInput)
Hope that helps
Confirm the function UCase(...) is working. Here is another example "Capitalize the first letter in the 2nd column from 2nd row till the end":
Sub UpCaseMacro()
' Declare variables
Dim OldValue As String
Dim NewValue As String
Dim FirstLetter As String
Dim i As Long
' Select values
lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
ActiveSheet.Range(Cells(2, 2), Cells(lastRow, 2)).Select
' Update data
For i = 2 To Selection.Rows.Count
If Not IsEmpty(Cells(i, 2).Value) Then
OldValue = Cells(i, 2).Value
FirstLetter = Left(Cells(i, 2).Value, 1)
NewValue = UCase(FirstLetter) & Right(OldValue, Len(OldValue) - 1)
Cells(i, 2).Value = NewValue
End If
Next i
End Sub
Related
I'm trying to look for values to create a final ticket number for a ticket reconciliation process. This is what should happen:
subroutine looks for a value in cell "Gx"
if it finds a value
pass value to function to strip out letters, convert to a number, pass back to subroutine to place in
cell "Ax"
if there is no value
pass value of "Cx" to function etc.
This loops through the number cells I have in my worksheet based on the number of rows filled in a separate column.
The function works fine by itself in the worksheet, but when I pass it a value from the subroutine column A fills up with the number of the row ie. A37=37, A8=8. I don't think I'm passing the argument correctly to the function, but I'm not certain. Here's the code for the subroutine and the function:
Sub final_ticket_number()
Dim rw As Integer
Dim i As Integer
'header label
Range("A1").Value = "Final Ticket #"
'set number of rows for loop
With Worksheets(1)
rw = .Range("B2").End(xlDown).Row
End With
'check col G for empty, use col C as backup
For i = 2 To rw
If Not IsEmpty(Cells(i, "G")) Then
'strip out letters in col G, place in col A
Cells(i, "A").Value = getNumeric("G" & i)
Else
'strip out letters in col C, place in col A
Cells(i, "A").Value = getNumeric("C" & i)
End If
Next i
End Sub
Function getNumeric(cellRef As String) As Long 'remove letters from ticket numbers
Dim stringLength As Integer
Dim i As Byte
Dim Result As String
stringLength = Len(cellRef)
'loops through each character in a cell to evaluate if number or not
For i = 1 To stringLength
If IsNumeric(Mid(cellRef, i, 1)) Then
Result = Result & Mid(cellRef, i, 1)
End If
Next i
'convert remaining characters to number
getNumeric = CLng(Result)
End Function
What am I missing?
As I understand it, the only thing that is wrong is your Len (cellRef), here you are only passing the range and not his value. See how I did it, I had to specify the spreadsheet, do the same that will work.
Use debug.print to see the outputs of the variables. Write in the code "debug.print XvariableX" and in the immediate check (Ctrl + G) you see the value assigned to the variable. good luck.
Sub final_ticket_number()
Dim rw As Integer
Dim i As Integer
Range("A1").Value = "Final Ticket #"
With Worksheets(1)
rw = .Range("B2").End(xlDown).Row
End With
For i = 2 To rw
If Not IsEmpty(Cells(i, "G")) Then
Cells(i, "A").Value = getNumeric("G" & i)
Else
Cells(i, "A").Value = getNumeric("C" & i)
End If
Next i
End Sub
Function getNumeric(cellRef As String) As Long 'remove letters from ticket numbers
Dim stringLength As Integer
Dim i As Byte
Dim Result As String
Dim Wrs As String
Wrk = ActiveWorkbook.Name
Workbooks(Wrk).Activate
Wrs = ActiveSheet.Name
stringLength = Len(Workbooks(Wrk).Worksheets(Wrs).Range(cellRef))
For i = 1 To stringLength
If IsNumeric(Mid(Workbooks(Wrk).Worksheets(Wrs).Range(cellRef), i, 1)) Then
Result = Result & Mid(Workbooks(Wrk).Worksheets(Wrs).Range(cellRef), i, 1)
End If
Next i
getNumeric = CLng(Result)
End Function
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
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
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).
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.
I have an sheet with column D where I have an ID in the format of
MG-456789 ; MG-Series ; MG-.
The above are the cases how the ID looks in my column D.
I would prefer to have an code, which works in such a way that, it checks for the number after MG - if there are 6 digits present, then it is valid, else I want it to be printed as invalid in column S.
For eg: if there is an ID like ; MG-Se then I want column S printed as invalid ; or MG- as invalid ; something like MG-456789 then its accepted and don't need to be printed in column S.
I tried to go through net and found Isnumeric can be used to check for the number in the cell. I could visualize for particular number but not a code for generic case like mine.
Can anyone help me how I can proceed with this case? any lead would be helpful.
Try this code.
Sub test()
Dim vDB, vR()
Dim Ws As Worksheet
Dim n As Long, i As Long, s As String
Set Ws = ActiveSheet
With Ws
vDB = .Range("d2", .Range("d" & Rows.Count).End(xlUp))
End With
n = UBound(vDB, 1)
ReDim vR(1 To n, 1 To 1)
For i = 1 To n
s = Replace(vDB(i, 1), "MG-", "")
If Len(s) = 6 And IsNumeric(s) Then
Else
vR(i, 1) = "false"
End If
Next i
Ws.Range("s2").Resize(n) = vR
End Sub
It's easy using Like operator:
If myString Like "MG-[0-9][0-9][0-9][0-9][0-9][0-9]" Then
MsgBox "Valid ID"
Else
MsgBox "Invalid ID"
End If
[0-9] stands for any digit, thus, it will match any string starting with MG- and followed by six digits.
You could also write it as a function to be called as
=CheckMG1(D2)
and pulled down
Function CheckMG1(s As String) As String
If Len(s) = 9 And Left(s, 3) = "MG-" And IsNumeric(Right(s, 6)) Then
CheckMG1 = "OK"
Else
CheckMG1 = "Invalid"
End If
End Function
A simpler code for you to try,
Sub MG()
Dim i As Long
For i = 1 To Cells(Rows.Count, "D").End(xlUp).Row
If IsNumeric(Replace(Cells(i, "D"), "MG-", "")) Then
Cells(i, "S") = "Valid"
Else
Cells(i, "S") = "InValid"
End If
Next i
End Sub
I'm currently struggling with the following problem
I'm trying to implement an input box where a user can input the character of the column.
After that, i dont know how to convert this into a number to use it in the Worksheet.Cells Method
For example: The User inputs "B", so the program saves it in a variable named x and converts it into a number so it can be used as Worksheet.Cells(Row, X)
Is there any method or does someone has an idea how to do this?
Cells() is your friend.
Don't overthink this.
Cells(1, 1) = "jello" ' changes cell A1
Cells(2, "AZ") = "too much jello" ' changes cell AZ2
The second argument of Cells() can be either a number or the alpha column header.
B is the second column, so you can use the expression (based on ASCII):
Sub main()
Dim s As String
s = "AB"
example s
End Sub
Sub example(s As String)
Dim colNum As Integer
Dim i As Integer
i = 1: colNum = 0
While (Mid(s, i, 1) <> "")
colNum = colNum * 26 + (Asc(UCase(Mid(s, i, 1))) - Asc("A") + 1)
i = i + 1
Wend
MsgBox colNum
End Sub
Function getColNum(colLetter As String) As Long
On Error Resume Next 'will return 0 if letter > last col
getColNum = Range(colLetter & "1").Column
End Function
I have a user-defined function in Excel that I run in multiple sheets. I am trying to use Cells(i, j) to pull the value of cells by their row and column in the sheet in which my function is called. Instead, Cells(i, j) pulls the value of cell [i,j] in the active sheet when I hit the 'Calculate Now' button, and auto-calculation does not work.
What am I doing wrong?
The full function is below, not sure if it's needed to answer my question.
Option Explicit
Option Base 1
Option Compare Text
Function recordString(ByVal width As Integer, ByVal height As Integer, ByVal firstCell As Range) As String
Application.Volatile
Dim tempString As String
tempString = ""
Dim i As Integer
Dim j As Integer
For i = firstCell.Row To firstCell.Row + height - 1
For j = firstCell.Column To firstCell.Column + width - 1
If IsEmpty(Cells(i, j)) Then
tempString = tempString & "0"
Else
tempString = tempString & "1"
End If
Next j
Next i
recordString = tempString
End Function
You need to use Application.Caller.
This will return the value in cell A1 of the sheet the function is entered to:
Public Function DisplayCaller() As String
DisplayCaller = Application.Caller.Parent.Cells(1, 1)
End Function
This will return the name of the calling sheet:
Public Function DisplayCaller() As String
DisplayCaller = Application.Caller.Parent.Name
End Function
For more info:
http://www.cpearson.com/excel/sheetref.htm