Ok, I've got this formula which generates usernames based on a list of first and last names. Now, while this works, I want the cells to refer to my own VBA function instead. But, I still want to use the original formula because of much less code.
I've got this formula:
=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(LOWER(LEFT(table[[#This Row];[Firstname:]])&table[[#This Row];[Lastname:]]);"æ";"a");"ø";"o");"å";"a")
This basically generates the username. But, I want to run this through a separate function, to find out if the username is already taken. And if it is, it should generate a slightly different user name.
I was thinking something along these lines:
Public Function genUserName(ByVal strFirstName, strLastName As String)
Dim strUsername As String
Set objDomain = GetObject("WinNT://grunnarbeid2.local")
objDomain.Filter = Array("User")
'FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(LOWER(LEFT(tableFaste[[#This Row];[Fornavn:]])&tableFaste[[#This Row];[Etternavn:]]);""æ"";""a"");""ø"";""o"");""å"";""a"")"
'strUsername = ActiveCell.FormulaR1C1
blnFound = False
For Each objUser In objDomain
If objUser.Name = strUsername Then
blnFound = True
Exit For
End If
Next
genUserName = strUsername
End Function
So, how do I combine these?
I would suggest limiting the functionality of genUserName to just checking uniqueness, and pass the result of your existing formual into it:
Public Function genUserName(ByVal strUsername As String)
Set objDomain = GetObject("WinNT://grunnarbeid2.local")
objDomain.Filter = Array("User")
blnFound = False
For Each objUser In objDomain
If objUser.Name = strUsername Then
blnFound = True
Exit For
End If
Next
genUserName = strUsername
End Function
then call it from a cell like
=genUserName(SUBSTITUTE( ... ))
Related
I have a form in MS Access that collects feedback from 4 users. After users have filled the form there's a variable called "sResultAll" that concatenates all feedback (from several textboxes) into it and passes its value to a Textbox called "txtRecommendation".
sResultAll = sResult1 & sResult2 & sResult3 & sResult4
txtRecommendation.Value = sResultAll
The problem I face is several users provide literally the same feedback so I need a way to eliminate duplicates within the variable sResultAll.
Thanks in advance for any contribution.
Friday evening 5:55, got nothing else to do. Here's a freebie:
As #braX suggested, a Dictionary Object is great at keeping track of unique strings because it can quickly search its current keys with the .Exists function. This lets you check if the string has already been entered, before adding it to the collection.
To improve this idea, I also suggest that you sanitize the strings before comparing them. Force them all to the same case and remove non-alphanumeric characters. This way, the strings will still match regardless of white-space, punctuation, or capitalization.
Sub Example()
Const sResult1 As String = "George"
Const sResult2 As String = "Fred"
Const sResult3 As String = "John"
Const sResult4 As String = "gEORGE "
Debug.Print Join(DistinctOf(sResult1, sResult2, sResult3, sResult4), ", ")
'Outputs: George, Fred, John
End Sub
Function DistinctOf(ParamArray Strings() As Variant) As Variant()
Dim AlphaNumericOnly As Object
Set AlphaNumericOnly = CreateObject("VBScript.RegExp")
With AlphaNumericOnly
.Global = True
.MultiLine = True
.Pattern = "[^A-Za-z0-9]+"
End With
Dim Distinct_Strings As Object
Set Distinct_Strings = CreateObject("Scripting.Dictionary")
Dim str As Variant
For Each str In Strings
Dim AO_str As String
AO_str = AlphaNumericOnly.Replace(LCase(str), "")
If Not Distinct_Strings.exists(AO_str) Then Distinct_Strings.Add AO_str, str
Next
DistinctOf = Distinct_Strings.Items
End Function
I have API functions in my excel that fetch live stock prices. I want to save the first live price at 9:15 am in a column, but as this value is fetched through a function, I am unable to modify another cell value. I tried calling subroutine inside the function, but it crashes the excel.
How can this be achieved?
I want the value exactly at 9:15 and not the values before or after that.
Can something like DictKeys be used?
My Code
Public Function GetRTD(Exch As String, TrdSymbol As String, Field As String)
On Error Resume Next
If Exch = "" Then
GetRTD = ""
Exit Function
End If
If TrdSymbol = "" Then
GetRTD = ""
Exit Function
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
Dim Prfx As String
Prfx = TrdSymbol & "." & Exch
GetRTD = WorksheetFunction.RTD("Kite.RtdServer", "", Prfx, Field)
Exit Function
End Function
Is it possible to:
Access a list of all variables in a VBA runtime environment?
Access the name of a variable with VBA?
Example:
function v2S(str as string) as string
For each variable in Variables
dim I as integer
for I = 1 to 10
v2S = replace(v2S,"%" & variable.name & "%", variable.value)
next
next
end function
Example use case:
Dim skyColor as string
skyColor = "green"
Debug.Print v2S("The sky is %skyColor% today!")
There is an application I can send commands to via a com object and I wish to do something along the lines of:
Dim i a integer
for i = 1 to MI.Eval("numtables()")
MI = GetObject(,"MapInfo.Application.x64")
debug.print MI.Eval(v2S("tableinfo(%i%,1)")) ' Print name of table
next
The above looks much cleaner than:
Dim i a integer
for i = 1 to MI.Eval("numtables()")
MI = GetObject(,"MapInfo.Application.x64")
debug.print MI.Eval(v2S("tableinfo(" & i & ",1)")) ' Print name of table
next
But of course if it were possible I would want it to be general which may be difficult...
For my own use case this is pretty good.
However it still isn't very readable. This is another option. It's more readable but also more cluttered:
Sub Main()
Dim Vars as object, myString as string
set Vars = CreateObject("scripting.Dictionary")
Vars.add "Var1","Val1"
Vars.add "Var2","Val2"
'...
myString = r("Var1: #{Var1} and Var2: #{Var2}", Vars)
End Sub
function r(byval s as string, byval o as object) as string
for each key in o.keys
s = replace(s,"#{" & key & "}",o.item(key))
next
r = s
end function
I wish string interpolation functionality existed by default in VBA.
I want to return true if some strings = 'XXXXX'
Where every X is a number 0 through 9
I know there must be a dozen ways to do this but I would like to know the best way.
yourString Like "#####"
If you want the simplest way, you can go with this:
Function MyFunction(myString As String) As Boolean
MyFunction = ((Len(myString) = 5) And (IsNumeric(myString)))
End Function
If you want the more efficient way, you'd have to run some tests for the different methods people suggested.
Edit: The previous solution doesn't work well (see the first 2 comments) but I'm letting it there since it's what has been accepted. Here is what I would do :
Function MyFunction(myString As String) As Boolean
Dim myDouble As Double
Dim myLong As Long
myDouble = Val(myString)
myLong = Int(myDouble / 10000)
MyFunction = ((Len(myString) = 5) And (myLong > 0) And (myLong < 10))
End Function
There is no error "protection" in that function, so if you try to check a too large number like 22222222222222, it will not work.
Similar question previously asked: link text
Basically want to check
(Len(s) = 5) And IsNumeric(s)
You can also use regular expressions to solve this problem. If you include Microsoft VBScript Regular Expressions 5.5 in your VBA project, you can use RegExp and MatchCollection variables as in the function below. (This is a modification of the response to this post at ozgrid.com.)
Public Function FiveDigitString(strData As String) As Boolean
On Error GoTo HandleError
Dim RE As New RegExp
Dim REMatches As MatchCollection
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "^[0-9][0-9][0-9][0-9][0-9]$"
End With
Set REMatches = RE.Execute(strData)
If REMatches.Count = 1 Then
FiveDigitString = True
Else
FiveDigitString = False
End If
Exit Function
HandleError:
Debug.Print "Error in FiveDigitString: " & Err.Description
FiveDigitString = False
End Function
is there a group_concat function in ms-access or something similar?
You should ask yourself if you need a generic solution (another is by Allen Browne) or if you need it just for the present purpose. If you really only need it this once, do it the easy way.
On a side note, when concatenating lists in VBA code, take advantage of a trick taught to me by long-time Access guru Trevor Best, and that's to stick the delimiter at the beginning of every value and then use Mid() to strip it off. Instead of this inside your loop through the child records:
If Len(strOutput) = 0 Then
strOutput = NewValue
Else
strOutput = strOutput & ", " & NewValue
End If
...use this inside the loop:
strOutput = strOutput & ", " & NewValue
...and then when you exit the loop, strip off the leading delimiter:
strOutput = Mid(strOutput, 3)
This has implications all over the place and simplifies code for concatenation in a whole host of contexts.
There's an access function to group multiple values into one value (a custom aggregate, I guess.) The link is http://www.rogersaccesslibrary.com/Otherdownload.asp?SampleName='Generic%20Function%20To%20Concatenate%20Child%20Records'
but the site is down for now. If you google the href, you'll find lots of referneces and examples.
I found this post by Duane Hookum (a Microsoft MVP) that claims to be able to do what you want. I have not tested it though.
By the way, in case you are interested, this is how I found it:
First search: group_concat access lead me to this post with this answer but the link was broken.
Then I searched again after the content that the answer was attempting to link to, and found it: site:http://www.rogersaccesslibrary.com/ concatenate.
No. Access does not have a GROUP_CONCAT function. However, it is possible to create a VBA function which will let you pass a string containing a SQL statement and get the equivalent functionality (not that I'd recommend it but it is possible).
Taking my own personal wayback machine, here is some code I wrote back when dinosaurs ruled the Earth:
Public Function ListQuery(SQL As String _
, Optional ColumnDelimiter As String = " " _
, Optional RowDelimter As String = vbCrLf) As String
'PURPOSE: to return a combined string from the passed query
'ARGS:
' 1. SQL is a valid Select statement
' 2. ColumnDelimiter is the character(s) that separate each column
' 3. RowDelimiter is the character(s) that separate each row
'RETURN VAL:
'DESIGN NOTES:
Const PROCNAME = "ListQuery"
Const MAXROWS = 100
Const MAXCOLS = 10
Dim oConn As ADODB.Connection
Dim oRS As ADODB.Recordset
Dim oField As ADODB.Field
Dim sRow As cString
Dim sResult As cString
On Error GoTo ProcErr
Set sResult = New cString
Set sRow = New cString
Set oConn = GetADOConn()
sResult.Clear
Do Until oRS.EOF
sRow.Clear
For Each oField In oRS.Fields
With sRow
If .Length > 0 Then
.Append ColumnDelimiter
End If
.Append Nz(oField.Value)
End With
Next oField
sRow.Trim
If sRow.Length > 0 Then
With sResult
.Append sRow
.Append RowDelimter
End With
End If
oRS.MoveNext
Loop
oRS.Close
oConn.Close
With sResult
If .Right(Len(RowDelimter)).Value = RowDelimter Then
.Length = .Length - Len(RowDelimter)
End If
End With
FunctionResult:
ListQuery = sResult.Value
CleanUp:
Set sResult = Nothing
Set sRow = Nothing
Set oField = Nothing
Set oRS = Nothing
Set oConn = Nothing
Exit Function
ProcErr:
' logging code...
Resume CleanUp
End Function
The GetADOConn function is a centralized function to retrieve the current database connection. cString is a class that mimics the behavior of .NET's StringBuilder class but was written long before .NET was anything other than a TLD and marketing hype. Since this is getting called on every row, VBA's built-in string concatenation will be slow and thus something like a StringBuilder class is needed. The original code (which I've partially modified) had a cap on the number of rows and columns that could be used which is what the constants are all about.