How do I properly exit a recursive function and return a value in VBA?
I have this simple code to remove multiple spaces from a string:
Public Function RemoveMultipleSpaces(s As String) As String
If InStr(1, s, " ", vbTextCompare) > 0 Then
Dim newS As String
newS = Replace(s, " ", " ")
RemoveMultipleSpaces (newS)
Else
RemoveMultipleSpaces = s
End
End If
End Function
But depending on what I use to exit either End or Exit Function, I either get nothing returned or an empty string.
A proper recursive function doesn't need a specific exit condition. You just stop calling the function recursively, and it exits.
However, if you want to explicitly exit, you can use Exit Function.
Your mistake, however, is that when you make a recursive call, you need to return the result of the recursive call.
Public Function RemoveMultipleSpaces(s As String) As String
If InStr(1, s, " ", vbTextCompare) > 0 Then
Dim newS As String
newS = Replace(s, " ", " ")
RemoveMultipleSpaces = RemoveMultipleSpaces(newS)
Else
RemoveMultipleSpaces = s
End If
End Function
Related
I have a field in my Access database that contains values such as 24,25,152, 128,152, ,113, 113 and NULLS.
When there is only one value present in the field I would like the first value to be my output (113 for ,113 and 113) and when there is more than one value present I would like the last value to be my output (152 for 24,25,152 and 128,152).
Right now I have a user-defined function that is invoked by a query that has been hard-coded to account for the correct number of commas/values present in the field. In the future there will be more commas so I would like to account for those and I'd like my output to be in a single column (as opposed to having one column per value after each comma).
Here is VBA code for that user-defined function which came from this post.
Function mySplit(sMyText As String, sDelim As String, lIndx As Long) As String
On Error GoTo Error_Handler
mySplit = Split(sMyText, sDelim)(lIndx)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 9 Then
mySplit = ""
Else
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: mySplit" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
End If
Resume Error_Handler_Exit
End Function
Here is the query:
SELECT Field, mySplit([field].[table],",",0) AS 1, mySplit([field].[table],",",1) AS 2, mySplit([field].[table],",",2) AS 3, Val(IIf([3]<>"",[3],IIf([2]<>"",[2],IIf([1]<>"",[1])))) AS [Value]
FROM Table;
Ideally I'd to have a single field that looks like the "Value" field (outlined in green) in the image below.
Right now that value field is a bunch of nested if statements looking at the 1, 2, and 3 columns. I know I need to modify this code to count the delimiters and then loop through each delimiter and take either the first value (if there is only one) and the last value (if there is more than one) but I am not sure how to go about achieving that.
Any help will be greatly appreciated.
EDIT
Try this.
Just Split the value and return the last element in the array. If the value is null, return an empty string.
Public Function SplitToLast(Value As Variant) As String
On Error GoTo Trap
If IsNull(Value) Then GoTo Leave
Dim arr As Variant
arr = Split(Value, ",")
SplitToLast = arr(UBound(arr))
Leave:
On Error GoTo 0
Exit Function
Trap:
MsgBox Err.Description, vbCritical
Resume Leave
End Function
Try this:
Public Function GetLastValue(ByVal value As Variant, ByVal delimiter As String) As String
If IsNull(value) Then Exit Function
If Len(delimiter) = 0 Then
GetLastValue = value
Exit Function
End If
Dim tmpValue As String
tmpValue = Trim(CStr(value))
Do While tmpValue Like "*" & delimiter
tmpValue = Trim(Left(tmpValue, Len(tmpValue) - Len(delimiter)))
Loop
If Len(tmpValue) = 0 Then Exit Function
Dim tmpArr() As String
tmpArr = Split(tmpValue, delimiter)
GetLastValue = tmpArr(UBound(tmpArr))
End Function
It also takes care of multiple delimiters at the end of the value like 1,2,3,, ,.
It also works if the length of the delimiter is > 1.
In case value is an empty string, the result will be an empty string too.
In case delimiter is an empty string, the result will be value.
This example calling works fine:
SELECT GetLastValue([Field1],",") AS LastValue FROM Table1
If you edit the query in the query design view and not in SQL view, take care of the , which separates the parameters. There it must be a ; instead.
I have done some research and haven't found any similar question.
I have a VBA macro that imports a .CSV file containing telegrams sent by a device.
In the end of this macro, I want to create a graph with the time elapsed on the x-axis and the value corresponding to the telegram.
The issue is that this value can be of different types: hexadecimal, boolean, integer... And that they don't respect the standard Excel number format, which means that they can't be used to create a graph.
Here are some examples (with " around the value to show its start and end) :
hexadecimal : "A7 C8"
Boolean : "$00" or ""$01"
Percentage : "$30"
And here is an example of data, with custom time format and boolean value
Here is my related code so far, where I try to convert into a custom type then convert back to numeric to get a common number datatype :
If wsRes.Range("R1").Value Like "$##" Then
wsRes.Range("R1:R" & plotLine).NumberFormat = "$##"
wsRes.Range("R1:R" & plotLine).NumberFormat = General
End If
If wsRes.Range("R1").Value Like "??[ ]??" Then
Dim valArray(1) As String
For i = 1 To plotLine Step 1
valArray = Split(wsRes.Range("R" & i), " ")
wsRes.Range("R" & i).Value = ToInt32(valArray(0) + valArray(1), 16)
wsRes.Range("" & i).NumberFormat = General
Next i
End If
I haven't been able to test it with hexa yet, but the conversion trick doesn't work with percentage/boolean
EDIT :
First, thank you for your answers.
Here is my final code for anyone's interested, adapted from Vityata's.
This method will allow to easily add other datatypes if needed.
Sub TestMe()
Dim RangeData as String
Set wsRes = ActiveWorkbook.Sheets("Results")
For i = 1 To plotLine Step 1 'plotLine is the last line on which I have data
DetectType wsRes.Range("R" & i).Value, i
Next i
RangeData = "Q1:R" & plotLine
CreateGraph RangeData 'Call My sub creating the graph
End Sub
Public Sub DetectType(str As String, i As Integer)
Select Case True
Case wsRes.Range("R" & i).Value Like "??[ ]??"
wsRes.Range("R" & i).Value = HexValue(str)
Case wsRes.Range("R" & i).Value Like "?##"
wsRes.Range("R" & i).Value = DecValue(str)
Case Else
MsgBox "Unsupported datatype detected : " & str
End
End Select
End Sub
Public Function HexValue(str As String) As Long
Dim valArray(1) As String 'Needed as I have a space in the middle that prevents direct conversion
valArray(0) = Split(str, " ")(0)
valArray(1) = Split(str, " ")(1)
HexValue = CLng("&H" & valArray(0) + valArray(1))
End Function
Public Function DecValue(str As String) As Long
DecValue = Right(str, 2)
End Function
You need three boolean functions, following your business logic and some of the Clean Code principles (although the author of the book does not recognize VBA people as programmers):
IsHex()
IsBoolean()
IsPercentage()
Public Sub TestMe()
Dim myInput As Variant
myInput = Array("A7C8", "$01", "$30")
Dim i As Long
For i = LBound(myInput) To UBound(myInput)
Debug.Print IsHex(myInput(i))
Debug.Print IsBoolean(myInput(i))
Debug.Print IsPercentage(myInput(i))
Debug.Print "-------------"
Next i
'or use this with the DetectType() function below:
'For i = LBound(myInput) To UBound(myInput)
' Debug.Print DetectType(myInput(i))
'Next i
End Sub
Public Function IsHex(ByVal str As String) As Boolean
On Error GoTo IsHex_Error
IsHex = (WorksheetFunction.Hex2Dec(str) <> vbNullString)
On Error GoTo 0
Exit Function
IsHex_Error:
End Function
Public Function IsBoolean(ByVal str As String) As Boolean
IsBoolean = CBool((str = "$00") Or (str = "$01"))
End Function
Public Function IsPercentage(ByVal str As String) As Boolean
IsPercentage = (Len(str) = 3 And Left(str, 1) = "$" And IsNumeric(Right(str, 2)))
End Function
Then some additional logic is needed, because $01 is both Boolean and Percentage. In this case, you can consider it Percentage. This is some kind of a mapper, following this business logic:
Public Function DetectType(str) As String
Select Case True
Case IsHex(str)
DetectType = "HEX!"
Case IsPercentage(str) And IsBoolean(str)
DetectType = "Boolean!"
Case IsPercentage(str)
DetectType = "Percentage!"
Case Else
DetectType = "ELSE!"
End Select
End Function
I'm having issues figuring out if I properly wrote this function. It'll be fed a string that either contains a "%" or a "#" as the last character ie. "TA_PQ_SI02_%". I just want this function to tell me if it's a % or #.
Did I do this in the most effiecient/proper way? I think not, and would like to learn why.
Private Function numberOrPercentCheck(ByVal cleanCode As String) As Boolean
Select Case cleanCode
Case Right(cleanCode , 1) = "#"
numberOrPercentCheck= True
Case Right(cleanCode , 1) = "%"
numberOrPercentCheck= False
Case Else
Debug.Print "Error: " & cleanCode & " is not formatted properly with a # or % at the end, and has been set to a default #"
numberOrPercentCheck = True
End Select
End Function
When you just want a Boolean:
Private Function numberOrPercentCheck(ByVal cleanCode As String) As Boolean
numberOrPercentCheck = Right(cleanCode, 1) = "#"
End Function
When you need a third possibility:
Private Function numberOrPercentCheck(ByVal cleanCode As String) As Variant
Select Case Right(cleanCode, 1)
Case "#": numberOrPercentCheck = True
Case "%": numberOrPercentCheck = False
Case Else: numberOrPercentCheck = "Error: " & cleanCode & " is not formatted properly with a # or % at the end"
End Select
End Function
I want to take a name in First Last format and change it to Last, First. I know I could to this with a formula but I want to be complicated.
Please let me know if you see any red flags in my code, or suggestions for improvements.
Function LastFirst(Name_FL As String)
'This only works if there is a single space in the cell - Will Error If Spaces <> 1
Length = Len(Name_FL) 'Establishes Length of String
Spaces = Length - Len(Application.WorksheetFunction.Substitute(Name_FL, " ", "")) 'Number of spaces
If Spaces <> 1 Then
LastFirst = "#SPACES!#" 'Error Message
Else
SpaceLocation = Application.WorksheetFunction.Find(" ", Name_FL, 1) 'Location of space
Last = Right(Name_FL, Length - SpaceLocation) 'Establishes Last Name String
First = Left(Name_FL, SpaceLocation) 'Establishes First Name String
LastFirst = Application.WorksheetFunction.Proper(Last & ", " & First) 'Puts it together
End If
End Function 'Ta-da
You could simplify it to:
Function LastFirst(Name_FL As String) As String
If (Len(Name_FL) - Len(Replace(Name_FL, " ", ""))) > 1 Then
LastFirst = "#SPACES#"
Else
LastFirst = StrConv(Split(Name_FL, " ")(1) & ", " & Split(Name_FL, " ")(0), vbProperCase)
End If
End Function
The logic here is:
If there is more than 1 space, return the error string #SPACES#
If there is 1 space, the split the string using " " as a delimiter.
Use the second index of the Split array, add ", " and use the first index of the split array.
Use StrConv() to convert it all to proper case.
You might also want to add another check for no spaces:
If InStr(Name_FL, " ") > 0 Then
'// There is a space in the string
Else
'// There is no space in the string
End If
Which can also be tested for by slightly changing the logic of the above example:
Function LastFirst(Name_FL As String) As String
If (Len(Name_FL) - Len(Replace(Name_FL, " ", ""))) = 1 Then
LastFirst = StrConv(Split(Name_FL, " ")(1) & ", " & Split(Name_FL, " ")(0), vbProperCase)
Else
LastFirst = "#SPACES#"
End If
End Function
Further elaboration on functions:
You can see I've used some VBA functions here in place of your WorksheetFunction methods.
Len() returns the Length of a string.
Replace() does what it says on the tin - replaces a given string with another.
StrConv() Converts a String to a respective case (e.g. vbProperCase).
Split() Creates a zero-based single dimension array from a string, by Splitting it on a given delimiter.
Finally - Don't forget to specify a return value in your function header:
Function LastFirst(Name_FL As String)As String<~~ return type
My application is downloading many diffrent files from network. There is possibility that some of the files could contain additional number within brackets like below:
report78-12-34-34_ex 'nothing to be removed
blabla3424dm_d334(7) '(7) - to be removed
erer3r3r3_2015_03_03-1945-user-_d334(31).xml '(31) - to be removed
group78-12-34-34_ex.html 'nothing to be removed
somereport5_6456 'nothing to be removed
As you see if (number) appear within filename it has to be removed. Do you have some nice secure method which could do the job?
I got some code from rakesh but it is not working when string doesn't contain (number):
string test="something(3)";
test=Regex.Replace(test, #"\d", "").Replace("()","");
Not working when e.g:
if i place file like this: UIPArt3MilaGroupUIAPO34mev1-mihe-2015_9_23-21_30_5_580.csv then it will show: UIPArtMilaGroupUIAPOmev-mihe--_.csv
And i would prefer not using regex.
Avoids Regex and checks the string inside the parentheses, only removing the substring if the enclosed string is a number.
Private Function NewFileName(ByVal FileName As String) As String
If FileName Like "*(*)*" Then
Try
Dim SubStrings() As String = Split(FileName, "(", 2)
NewFileName = SubStrings(0)
SubStrings = Split(SubStrings(1), ")", 2)
SubStrings(0) = NewFileName(SubStrings(0))
SubStrings(1) = NewFileName(SubStrings(1))
If IsNumeric(SubStrings(0)) Then
NewFileName &= SubStrings(1)
Else
Return FileName
End If
Catch
Return FileName
End Try
Else
Return FileName
End If
End Sub
I would do something like this:
Public Function GetFileName(ByVal fileName As String) As String
Dim lastOpenBracketPos As Integer = fileName.LastIndexOf("(")
Dim lastCloseBracketPos As Integer = fileName.LastIndexOf(")")
If lastOpenBracketPos <> -1 AndAlso lastCloseBracketPos <> -1 AndAlso lastCloseBracketPos > lastOpenBracketPos Then
Dim bracketsText As String = fileName.Substring(lastOpenBracketPos, lastCloseBracketPos-lastOpenBracketPos+1)
If IsNumeric(bracketsText.Trim("(",")")) Then
Return fileName.Replace(bracketsText,"")
End If
End If
Return fileName
End Function
Out of all code here i made out my own one because it has to be ensured that before every playing with filename first has to be checked how many brackets within filename - only if 1 for open and 1 for close bracket is there then go with checking. What do you think is there any issue i don;t see or something which could be tuned up?
Private Function DeleteBrackets(ByVal fn As String) As String
Dim countOpenBracket As Integer = fn.Split("(").Length - 1
Dim countCloseBracket As Integer = fn.Split(")").Length - 1
'-- If only one occurence of ( and one occurence of )
If countOpenBracket = 1 And countCloseBracket = 1 Then
Dim filextension = IO.Path.GetExtension(fn)
Dim filewithoutExtension As String = IO.Path.GetFileNameWithoutExtension(fn)
'Debug.Print("Oryginal file name = " & fn)
'Debug.Print("File name without extension = " & filewithoutExtension)
'Debug.Print("Extension = " & IO.Path.GetExtension(fn))
If filewithoutExtension.EndsWith(")") Then
fn = filewithoutExtension.Remove(filewithoutExtension.LastIndexOf("("))
'Debug.Print("After removing last index of ( = " & fn)
'Debug.Print("Adding again extension = " & fn & filextension)
End If
'Debug.Print(fn)
End If
Return fn
End Function