Custom Access Calculated Field Function - vba

I would like to create a Custom Calculated Field Function For MS-Access. The reason being that there is no reason to run a query, and each row could possibly have two different results based on a field type. I have a function VBA Function. However I cannot use it to calculate a calculated field.
Environment:
Windows 10
Office 2010
Code
Key Types Enumeration
VBA
Public Enum KeyTypes
FullField = -1
RemoveSpaces = 0
FirstThreeLetters = 3
FirstFourLetters = 4
FirstLetterOfEachWord = 11
FirstTwoLettersOfEachWord = 22
CombineSubKeys = 2
End Enum
Create Key Function
VBA
Public Function CreateKey(KeyType As KeyTypes, KeyString1 As String, Optional Delimiter As String = "", Optional KeyString2 As String = "") As String
Dim tmp() As String ' For Splitting String by Spaces in cases FirstLetterOfEachWord and FirstTwoLettersOfEachWord
'StrConv(KeyString1, VbProperCase) capitalizes the first letter of each word
Select Case KeyType
Case FullField ' if Return Full Field as key
CreateKey = KeyString1
Case CombineSubKeys ' If combine two keys with delimiter
CreateKey = KeyString1 & Delimiter & KeyString2
Case FirstThreeLetters ' Create Key From First 3 Letters Of String
CreateKey = Left(StrConv(KeyString1, vbProperCase), 3)
Case FirstFourLetters ' Create Key From First 4 Letters Of String
CreateKey = Left(StrConv(KeyString1, vbProperCase), 4)
Case FirstLetterOfEachWord ' Create Key From First Letter of Each Word In String
tmp = Split(StrConv(KeyString1, vbProperCase), " ")
CreateKey = ""
For Each KeyC In tmp
CreateKey = CreateKey & Left(KeyC, 1)
Next
Case FirstTwoLettersOfEachWord ' Create Key From FirstTwo Letters of Each Word In String
tmp = Split(StrConv(KeyString1, vbProperCase), " ")
CreateKey = ""
For Each KeyC In tmp
CreateKey = CreateKey & Left(KeyC, 2)
Next
Case RemoveSpaces ' Create Key String by Removing Spaces
CreateKey = Replace(KeyString1, " ", "")
Case Else ' If Invalid Key Type, Output KeyString1
CreateKey = FirstKeyString
End Select
End Function
End Function
Tables
Data Set Structures are Bulleted Lists So I can list out the properties of the different fields.
Key Types
Table Name is KeyTypes
Data Set Structure
Key
Text
Enumeration
Number
Integer
Indexed (No Duplicates)
Index
Number
Integer
Indexed (No Duplicates)
Data Set Example
Key
Enumeration
Index
Full Field
-1
1
Remove Spaces
0
2
First 3 Letters
3
3
First 4 Letters
4
4
First Letter of Each Word
11
5
First Two Letters Of Each Word
22
6
Combine SubKeys
2
7
Main Data
Table Name is MainData
Main Data Set Structure
Field 1
Text
Field 2
Text
-Field 1 Key Type
Number
Long Integer
0 Decimal Places
Lookup = Combobox
-Row Source (SQL)= SELECT KeyTypes.Key, KeyTypes.Enumeration, KeyTypes.Index FROM KeyTypes ORDER BY KeyTypes.Index;
Multiple Values= No
Bound Column =2
-Field 2 Key Type
Number
Long Integer
0 Decimal Places
Lookup = Combobox
-Row Source (SQL)= SELECT KeyTypes.Key, KeyTypes.Enumeration, KeyTypes.Index FROM KeyTypes ORDER BY KeyTypes.Index;
Multiple Values= No
Bound Column =2
Field 1 Key
Calculated
Expression: = CreateKey([Field 1 Key Type],[Field 1])
Field 2 Key
Calculated
Expression: = CreateKey([Field 2 Key Type],[Field 2])
Full Key
Calculated
-Expression: = `CreateKey(2,[Field 1 Key],".",[Field 2 Key])
Main Data Set Example
Field 1
Field 2
Field 1 Key Type
Field 2 Key Type
Field 1 Key
Field 2 Key
Full Key
hello
World
Full Field
Full Field
hello
World
hello.World
welcome to
programming
First Two Letters Of Each Word
First 4 Letters
WeTo
Prog
WeTo.Prog
Ready
World
First 4 Letters
First 3 Letters
Read
Wor
Read.Wor
Are You Ready To Begin
Programming
First Letter of Each Word
First 4 Letters
AYRTB
Prog
AYRTB.Prog
Current Output
Error Message(s)
If I attempt to create an expression for the table column using the function when I save the table I get a message which says the following:
The Expression CreateKey( [Field 1 Key Type] , [Field 1] ) cannot be used in a calculated column
Which is followed by another message:
Errors were encountered during the save operation. Fields were not added. Properties were not updated.

Related

Read number of characters in a column of a GuiTableControl object

I'm trying to read the number of characters in column "MRP element data" in tcode MD04.
Below code is giving me 1 but I want it to give 16 or it should give 16 provided that my code is right...If there is one more row with one more Purchase Order it should give 32 etc.
j = 0
Do
session.findById("wnd[0]/usr/subINCLUDE1XX:SAPMM61R:0750/tblSAPMM61RTC_EZ/txtMDEZ-EXTRA[5," & CStr(j) & "]").caretPosition = 0
objSheet.Cells(i, 2) = Len(Cstr(j))
Exit Do
j =j + 1
Loop
You currently calculate the length of the integer variable j which contains the value 0, it's why you get 1.
The table element you show is a GuiTableControl object. You will find the method GetCell to read the content of a cell, and after that you can calculate the length of its value.
Set tableControl = session.findById("wnd[0]/usr/subINCLUDE1XX:SAPMM61R:0750/tblSAPMM61RTC_EZ")
MsgBox Len(tableControl.GetCell(1,5).Text)
(row 1 = second row; column 5 = sixth column)

How to divide line of text that has both text and numbers with $ sign in front of it?

I want to divide this array of texts into 3 divisions
SAMPLE TEXT:
Personal injury during holiday $10,000
Property damage $100,000
Car damage $10,000 for third party
Property damage $100,000 for properties located in the City area
$20,000 each and every policy
And it should be organized like this:
Division 1 - full text before numbers
Division 2 - Numbers, it always starts with $
Division 3 - full text after numbers
Note:
The number of words before and after the number is inconsistent. Only the $ sign is consistent.
You can use this, The code might look complex but by studying it you will understand it
Dim test As String = "your string here"
'Split the text into lines and store in array
Dim split1() As String = Split(test, vbLf)
Dim split2() As String
Dim split3() As String
For x As Integer = 0 To Ubound(split1) - 1
split2 = Split(split1(x))
For y As Integer = 0 To Ubound(split2) - 1
If split2(y).StartsWith("$") Then
For z As Integer = 0 To y - 1
split3(0) &= split2(z)
Next
split3(1) = split2(y)
If y < Ubound(split2) - 1 Then
For a As Integer = y + 1 To Ubound(split2) - 1
split3(2) &= split2(y)
Next
End If
End If
For b As Integer = 0 To 2
Console.WriteLine(split3(x))
' or you could use Textbox.Text += split3(x)
' Do whatever you want with those values here
'split3(0) = Text before $ sign
'split3(1) = Text with $ sign
'split3(2) = Text after $ sign
Next
Next
Next
Regex is ideal for this. I will show an example for one line but you can apply it to every line in a loop.
Dim str = "Car damage $10,000 for third party"
'Create regex which matches three groups:
'Group 1: (.*) ==> matches any characters
'Group 2: (\$[\d,]+) ==> matches $ followed by one or more digits and/or comma (,)
'Group 3: (.*) ==> matches any characters
Dim regex = New Regex("(.*)(\$[\d,]+)(.*)")
Dim match = regex.Match(str)
'Get values for all groups, skipping the first one which matches the whole string.
Dim parts = match.Groups.Cast(Of Group).Skip(1).Select(Function(g) g.Value).ToArray()
You get this array as a result:

Get integer data from word tables

I have several word tables that I want to edit based on the value in the last row of the column. I want to delete column contents (except last row of specified column) if the value in the last row exceeds 20.
I have used . Range. Textbut I am having challenges with its implementation. I have this
For i = 3 To . Columns. Count
If ActiveDocument.Tables(i).Cell(ActiveDocument. Tables(i).Rows.Count, i).Range.Text >20 Then ...
How can I get VBA to return the contents of a cell not as a string but as an integer for calculation.
VBA's VAL() function will convert a string containing a numeric value into a number. The function starts from the left and recognises numbers until a non-numeric character is encountered and ignores everything that follows. In the case of text taken from a table cell that is very useful because the End-Of-Cell marker included in the text will be ignored.
Dim C As Long
For C = 1 To 3
With ActiveDocument.Tables(1)
If Val(.Rows.Last.Cells(C).Range.Text) > 20 Then
Debug.Print "Delete rows above"
End If
End With
Next C

Best way to populate an excel string column for fastest subsequent vba search (can I use metadata, etc?)

In a column with hundreds or even 1-2 thousand strings of approximately 40 characters, with one string per cell and many repeating entries, what is the best way to populate the column to conduct the fastest possible search later? The search should return a row number so that the corresponding row can be deleted.
Is there some way to append metadata or label to a cell/row for faster search? Is there some other mechanism that can identify cells that will make searching easier?
I'm new to VBA, and I want to set out on the best path before I get too far into the project and have to search through thousands of strings.
edit: Someone requested an example cell: The cells will have email addresses in them. I can control the email addresses on the server, so they will roughly be 40 characters long each. They will contain alphanumeric characters only.
Example of a fast way to implement a dictionary lookup
Data is on Sheet1, and starts in column A
The strings are in column B
Option Explicit
Public Sub SearchStrings()
Dim ur As Variant, r As Long, d As Object
Const COL_ID = 2
Set d = CreateObject("Scripting.Dictionary") 'or Reference to Microsof Scripting Runtime
d.CompareMode = TextCompare 'Case insensitive, or "BinaryCompare" otherwise
ur = Sheet1.UsedRange.Columns(COL_ID) 'read strings from column COL_ID into array
For r = LBound(ur) To UBound(ur) 'populate dictionary; Key = string (unique)
If Not IsError(ur(r, 1)) Then d(CStr(ur(r, 1))) = r 'Item = row id
Next
Debug.Print d.Keys()(3) 'prints the string in row 3
Debug.Print d.Items()(3) 'prints the row number of the 3rd string
End Sub
If you want to store string duplicates use this:
If Not IsError(ur(r, 1)) Then d(COL_ID & "-" & r) = CStr(ur(r, 1))
which is Key = Column ID & "-" & row ID (2-5), and Item = String itself

Excel VBA Text to Columns Backwards with maximum # of columns

Apples, Oranges, Strawberries, Pears, Almonds, Peanuts, Peaches
I would like to find "," from backwards (instrrev) and perform something similar to text to columns function in Excel, which would
#1 > Apples, Oranges
#2 > Apples | Oranges
perform action that takes #1 to #2.
However, I would like to have maximum columns of 5 (split into 5 pieces and the split-base character searched from backwards)
so that the top example would result in:
Apples, Oranges, Strawberries | Pears | Almonds | Peanuts | Peaches
Please keep in mind that it is possible for the text to have no commas, so I need to check if they exists first
Thanks for the help!
Try this, by putting your example text in a cell, selecting that cell and then running the below. You will need to test this, and possibly handle some scenarios yourself - but this code should get you going and works on your example.
Sub SplitIntoColumns()
Dim intMaxCols As Integer
Dim intCommaFoundPos As Integer
Dim intNumCommasFound As Integer
Dim strTextToCheck As String
Dim strFoundText As String
Dim intRowToWriteTo As Integer
Dim intColToWriteTo As Integer
'this should be max num of columns you want -1
intMaxCols = 4
'just putting the text into the activecell and running on that
strTextToCheck = ActiveCell
'row to write output to
intRowToWriteTo = 10
'column to write output to - it will go backwards from here
intColToWriteTo = 10
'find the comma
intCommaFoundPos = InStrRev(strTextToCheck, ",")
'if there is a comma
If intCommaFoundPos > 0 Then
'loop until you have looped the max columns number of times, or until there are no commas left in the string
Do Until (intNumCommasFound = intMaxCols) Or intCommaFoundPos = 0
'get comma position
intCommaFoundPos = InStrRev(strTextToCheck, ",")
'if there is still a comma
If intCommaFoundPos > 0 Then
'keep track of the number found
intNumCommasFound = intNumCommasFound + 1
'take everything to right of comma
strFoundText = Trim(Mid(strTextToCheck, intCommaFoundPos + 1, Len(strTextToCheck)))
'write to sheet, adjust next column number
ActiveSheet.Cells(intRowToWriteTo, intColToWriteTo) = strFoundText
intColToWriteTo = intColToWriteTo - 1
'change the text to check to not include the word just found
strTextToCheck = Left(strTextToCheck, intCommaFoundPos - 1)
End If
Loop
'if there is any text left, write to sheet
If Len(strTextToCheck) > 0 Then ActiveSheet.Cells(intRowToWriteTo, intColToWriteTo) = strTextToCheck
End If
End Sub
You can also implement it in formula:
=IF(LEN(A3)-LEN(SUBSTITUTE(A3,",",""))<5,SUBSTITUTE(A3,",","|"),REPLACE(A3,FIND("#",SUBSTITUTE(A3,",","#",LEN(A3)-LEN(SUBSTITUTE(A3,",",""))-4))+1,LEN(A3),SUBSTITUTE(MID(A3,FIND("#",SUBSTITUTE(A3,",","#",LEN(A3)-LEN(SUBSTITUTE(A3,",",""))-4))+1,LEN(A3)),",","|")))
with the string in A3
How it works:
Find out the number of "," in the string by subtracting length of comma-less string from full string.
if less than 5 commas then substitute all "," with "|"
if equal to or more than 5 commas then, find the character position of the 5th comma from right,and replace the string after that character position with the substituted string.