I want to reference a table in access to replace words in a comment box. I would search for the words in column 1 and replace them with the words in column 2. I'm not sure how to properly name the columns to insert them in a replace function.
Here is an example of code I am trying to use,
Private Sub Replace_Click()
Dim bullet As String
Dim output As String
bullet = commentBox.Value
commentBox.Value = Replace(bullet, [tbl_name].column_name, [tbl_name].column_name)
End Sub
Options to consider:
Open a recordset of the table, loop through records and execute Replace on each value. If value is in string it will be replaced, if it's not in string then nothing happens.
Sub SubAbb()
Dim rs As DAO.Recordset, sStr As String
Set rs = CurrentDb.OpenRecordset("SELECT Word, Abb FROM Words")
sStr = Me.commentBox
Do While Not rs.EOF
sStr = Replace(sStr, rs!Word, rs!Abb)
rs.MoveNext
Loop
Me.commentBox = sStr
End Sub
Split string to an array, loop through array and do a DLookup on table. If abbreviation found, run Replace on the string. However, this presumes string has only words separated by single space, no punctuation or numbers or dates, which will complicate code.
Sub SubAbb()
Dim sStr As String, sAbb As String, sAry As Variant, x As Integer
sStr = Me.commentBox
sAry = Split(sStr, " ")
For x = 0 To UBound(sAry)
sAbb = Nz(DLookup("Abb", "Words", "Word='" & sAry(x) & "'"), "")
If sAbb <> "" Then sStr = Replace(sStr, sAry(x), sAbb)
Next
Me.commentBox = sStr
End Sub
Related
We import XML files into an Access database. This data includes a description column which can contain special characters like ä é etc. We use this database to export a table to our Financial programm. This programm can't handle these special characters. Therefore I would like to make a VBA function that can replace any special character within a specific table/colomn.
I am fairly new to using VBA, so I used Google a lot to try to find some background about this topic. I have found this code for Excel, and think this can be used in Access as well. However, I can't make the connection with the Update table function.
Function RemovePunctuation(Txt As String) As String
With CreateObject("VBScript.RegExp")
.Pattern = "[^A-Z0-9 ]"
.IgnoreCase = True
.Global = True
RemovePunctuation = .Replace(Txt, "")
End With
End Function
The Function above (RemovePunctuation) works with the Query in Access and returns a list with the values of the original table without any punctuation. I used the following Query:
SELECT RemovePunctuation([ColumnName]) AS [Add]
FROM TableName;
However, this returns a new table instead of replacing the values in the original table. Can information be shared on a different Query which uses the function to update originale table?
Cause I'm really new to this, I can't show much. I would expect the code to look like:
Function UpdateTable(Table As String, Column As String) As String
Update Table Set Column =
With CreateObject("VBScript.RegExp")
.Pattern = "[^A-Z0-9 ]"
.IgnoreCase = True
.Global = True
RemovePunctuation = .Replace(Txt, "")
End With
End Function
But this returns nothing.
Expected result should be returning spaces where special characters are in column selected.
As mentioned, code returns nothing so far as this isn't a valid function at all. Please advise.
In case the xml file is not linked, but indeed imported, you have full control of the imported data. You could create an additional table, where you have a field 'TableName' for each xml file, a field 'FieldName' for each column, a field 'CharIn' for each special character to validate and a field 'CharOut' for the replacing character. Then build code to walk through the imported data, and then search and replace based upon your new additional table. Replace is a default function, but you could write your own, something like
Function ReplaceString(strCaller As String, memText As Variant, strSearch As String, strReplace As String) As Variant
'Define variables
Dim dblPos As Double 'pointer in text
'Walk through the text, search and replace
dblPos = InStr(memText, strSearch)
Do While dblPos > 0
If Asc(strSearch) = Asc(Mid$(memText, dblPos, 1)) Then
memText = Left$(memText, dblPos - 1) + strReplace + Mid$(memText, dblPos + Len(strSearch))
dblPos = Abs(dblPos - Len(strSearch))
End If
dblPos = InStr(dblPos + 1, memText, strSearch)
Loop
ReplaceString = memText
Based on code provided by #jeroen jong, the question is answered. Provided code to replace special characters in any given table in Access is the following:
One module is made with the following code:
Option Compare Database
Option Explicit
Private Const strObject As String = "modConversion"
Function ReplaceString(strCaller As String, memText As Variant, strSearch As String,
strReplace As String) As Variant
On Error GoTo Err_Function
'Define variables
Dim strProcedure As String 'name of current procedure
Dim dblPos As Double 'pointer in text
'Initialise variables
strProcedure = "ReplaceString"
'Walk through the text, search and replace
dblPos = InStr(memText, strSearch)
Do While dblPos > 0
If Asc(strSearch) = Asc(Mid$(memText, dblPos, 1)) Then
memText = Left$(memText, dblPos - 1) + strReplace + Mid$(memText, dblPos + Len(strSearch))
dblPos = Abs(dblPos - Len(strSearch))
End If
dblPos = InStr(dblPos + 1, memText, strSearch)
Loop
ReplaceString = memText
Exit_Function:
Exit Function
Err_Function:
MsgBox Err.Number, Err.Description, Err.Source, strObject, strProcedure
ReplaceString = memText
Resume Exit_Function
End Function
One function is created the call the ReplaceString function. In this case it is called from a Form with a button:
Option Compare Database
Option Explicit
Private Const strObject As String = "frmReplace"
Private Sub cmdReplace_Click()
On Error GoTo Err_Sub
'Define variables
Dim strProcedure As String 'name of current procedure
Dim dbs As DAO.Database
Dim rsTable As DAO.Recordset
Dim rsReplace As DAO.Recordset
Dim strFieldName As String
'Initialise variables
strProcedure = "cmdReplace_Click"
'Initialise database and recordset
Set dbs = CurrentDb
Set rsReplace = dbs.OpenRecordset("tblReplace", dbReadOnly)
With rsReplace
Do While Not .EOF
'Open table
Set rsTable = dbs.OpenRecordset(!TableName, dbOpenDynaset)
'Walk through all records, and replace char in field
Do While Not rsTable.EOF
rsTable.Edit
rsTable(!FieldName) = ReplaceString(strProcedure, rsTable(!FieldName), !TextSearch, !TextReplace)
rsTable.Update
rsTable.MoveNext
Loop 'rsTable
.MoveNext
rsTable.Close
Loop 'rsReplace
.Close
End With
MsgBox "Replacement of special characters is completed", vbInformation, "Replace"
Exit_Sub:
On Error Resume Next
rsTable.Close
Set rsTable = Nothing
rsReplace.Close
Set rsReplace = Nothing
dbs.Close
Set dbs = Nothing
Exit Sub
Err_Sub:
MsgBox Err.Number & " - " & vbLf & Err.Description & " - " & vbLf & Err.Source, vbCritical, strObject & "-" & strProcedure
Resume Exit_Sub
End Sub
The table to provide data to search and replace consists of the following columns:
Id As Id;
TableName As String;
FieldName As String;
Replace As Boolean;
TextSearch As String;
TextReplace As String;
CaseSensitive As Boolean;
Again thanks for solving my question!
I have a variable with a string...and I want to know if it contains any value other than single quote, comma and a space ("', ") I'm using vba in excel.
for example, i have a varible strA = "'test', 'player'"
I want to check to see if strA has any characters other than "', " (single quote, comma and space).
Thanks
Here is a strategy based on Count occurrences of a character in a string
I don't have vba handy, but this should work. The idea is to remove all these characters and see if anything is left. text represents your string that is being tested.
Dim TempS As String
TempS = Replace(text, " " , "")
TempS = Replace(TempS, "," , "")
TempS = Replace(TempS, "'" , "")
and your result is Len(TempS>0)
Another approach is to use recursion by having a base case of false if the string is empty, if the first character is one of the three call ourselves on the rest of the string, or if not the value is true. Here is the code
function hasOtherChars(s As String) As Boolean
hasOtherChars=false
if (len(s)=0) then
exit function
end if
Dim asciiSpace As Integer
asciiSpace = Asc(" ")
Dim asciiComma As Integer
asciiComma= Asc(",")
Dim asciiApostrophe As Integer
asciiApostrophe = Asc("'")
Dim c as Integer
c = Asc(Mid$(s, 1, 1))
if ((c=asciiSpace) or (c=asciiComma) or (c=asciiApostrophe)) then
hasOtherChars = hasOtherChars(Mid$(s,2))
else
hasOtherChars=true
end if
End function
Again I am borrowing from the other thread.
I am trying to split data using VBA within word.
I have got the data using the following method
d = ActiveDocument.Tables(1).Cell(1, 1).Range.Text
This works and gets the correct data. Data for this example is
This
is
a
test
However, when I need to split the string into a list of strings using the delimiter as \n
Here is an example of the desired output
This,is,a,test
I am currently using
Dim dataTesting() As String
dataTesting() = Split(d, vbLf)
Debug.Print dataTesting(0)
However, this returns all the data and not just the first line.
Here is what I have tried within the Split function
\n
\n\r
\r
vbNewLine
vbLf
vbCr
vbCrLf
Word uses vbCr (ANSI 13) to write a "new" paragraph (created when you press ENTER) - represented in the Word UI by ¶ if the display of non-printing characters is activated.
In this case, the table cell content you show would look like this
This¶
is¶
a¶
test¶
The correct way to split an array delimited by a pilcro in Word is:
Dim d as String
d = ActiveDocument.Tables(1).Cell(1, 1).Range.Text
Dim dataTesting() As String
dataTesting() = Split(d, vbCr)
Debug.Print dataTesting(0) 'result is "This"
You can try this (regex splitter from this thread)
Sub fff()
Dim d As String
Dim dataTesting() As String
d = ActiveDocument.Tables(1).Cell(1, 1).Range.Text
dataTesting() = SplitRe(d, "\s+")
Debug.Print "1:" & dataTesting(0)
Debug.Print "2:" & dataTesting(1)
Debug.Print "3:" & dataTesting(2)
Debug.Print "4:" & dataTesting(3)
End Sub
Public Function SplitRe(Text As String, Pattern As String, Optional IgnoreCase As Boolean) As String()
Static re As Object
If re Is Nothing Then
Set re = CreateObject("VBScript.RegExp")
re.Global = True
re.MultiLine = True
End If
re.IgnoreCase = IgnoreCase
re.Pattern = Pattern
SplitRe = Strings.Split(re.Replace(Text, ChrW(-1)), ChrW(-1))
End Function
If this doesn't work, there may be strange unicode/Wprd characters in your Word doc. It may be soft breaks, for instance. You could try to not split with "\W+" in stead of "\s+". I cannot test this without your document.
Dim dataTesting() As String
dataTesting() = Split(d, vbLf)
Debug.Print dataTesting(0)
works fine and thank you very much for your example,
for why it have returned a whole array is because you have used 0 as index, in many programming languages 0 is the whole array, so the first element is ,
so in my case counting from 1 this perfectly split a string that I had troubles with.
To be more exact this is how it was used in my case
Dim dataTesting() As String
dataTesting() = Split(Document.LatheMachineSetup.Heads.Item(1).Comment, vbCrLf)
MsgBox (dataTesting(1))
And that comment is a multiline string.
Image
So this msg box returned exactly first line.
I'm using Access 2016. I have created a function that I've passed to a query - the function's role is to parse a memo (long text) field down from 3-4k characters (parses the string between 2 markers) to a length I can work with. Here is the function:
Function getBASE(sStrx)
Dim sTemp, iBEG As Integer, iEND As Integer, sBEG As String, sEND As String
'
If InStr(UCase(sStrx), "FROM ") > 1 And InStr(sStrx, "{") > 1 Then
iBEG = InStr(sStrx, "{") + 1
iEND = InStr(sStrx, "}") - iBEG
getBASE = Mid(sStrx, iBEG, iEND)
End If
'
End Function
The resultant length of this is around 700 characters. When I create a LEN on the result, I get 700 chars. I then run a sub (code below) that contains a Split function, but the result of the split is 255 characters. However, I have a couple of msgbox's that pop up to check the length of the recordset value and it's 700 (the correct length), but for some reason, it's truncating. I don't know if this is due the function, the sub, or something else. One other thing: I can pass the original value (3-4k chars) to the sub and it works fine. I'm beyond frustrated...thx for the help.
Sub Break_String()
Dim db As DAO.Database, rsSource As DAO.Recordset, rsDest As DAO.Recordset
Set db = CurrentDb()
Set rsSource = db.OpenRecordset("qTEST")
Set rsDest = db.OpenRecordset("tblParsed")
Dim WrdArray() As String
rsSource.MoveFirst
WrdArray() = Split(UCase(rsSource("[getBASE]")), "FROM ")
'
MsgBox Len(rsSource("[getBASE]")) <---- 700 chars
For i = LBound(WrdArray) To UBound(WrdArray)
strg = strg & vbNewLine & WrdArray(i)
Next i
'
MsgBox strg <----- 255 chars
End Sub
I am trying to remove words appearing in one string from a different string using a custom function. For instance:
A1:
the was why blue hat
A2:
the stranger wanted to know why his blue hat was turning orange
The ideal outcome in this example would be:
A3:
stranger wanted to know his turning orange
I need to have the cells in reference open to change so that they can be used in different situations.
The function will be used in a cell as:
=WORDREMOVE("cell with words needing remove", "cell with list of words being removed")
I have a list of 20,000 rows and have managed to find a custom function that can remove duplicate words (below) and thought there may be a way to manipulate it to accomplish this task.
Function REMOVEDUPEWORDS(txt As String, Optional delim As String = " ") As String
Dim x
'Updateby20140924
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each x In Split(txt, delim)
If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing
Next
If .Count > 0 Then REMOVEDUPEWORDS = Join(.keys, delim)
End With
End Function
If you can guarantee that your words in both strings will be separated by spaces (no comma, ellipses, etc), you could just Split() both strings then Filter() out the words:
Function WORDREMOVE(ByVal strText As String, strRemove As String) As String
Dim a, w
a = Split(strText) ' Start with all words in an array
For Each w In Split(strRemove)
a = Filter(a, w, False, vbTextCompare) ' Remove every word found
Next
WORDREMOVE = Join(a, " ") ' Recreate the string
End Function
You can also do this using Regular Expressions in VBA. The version below is case insensitive and assumes all words are separated only by space. If there is other punctuation, more examples would aid in crafting an appropriate solution:
Option Explicit
Function WordRemove(Str As String, RemoveWords As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.ignorecase = True
.Global = True
.Pattern = "(?:" & Join(Split(WorksheetFunction.Trim(RemoveWords)), "|") & ")\s*"
WordRemove = .Replace(Str, "")
End With
End Function
My example is certainly not the best code, but it should work
Function WORDREMOVE(FirstCell As String, SecondCell As String)
Dim FirstArgument As Variant, SecondArgument As Variant
Dim FirstArgumentCounter As Integer, SecondArgumentCounter As Integer
Dim Checker As Boolean
WORDREMOVE = ""
FirstArgument = Split(FirstCell, " ")
SecondArgument = Split(SecondCell, " ")
For SecondArgumentCounter = 0 To UBound(SecondArgument)
Checker = False
For FirstArgumentCounter = 0 To UBound(FirstArgument)
If SecondArgument(SecondArgumentCounter) = FirstArgument(FirstArgumentCounter) Then
Checker = True
End If
Next FirstArgumentCounter
If Checker = False Then WORDREMOVE = WORDREMOVE & SecondArgument(SecondArgumentCounter) & " "
Next SecondArgumentCounter
WORDREMOVE = Left(WORDREMOVE, Len(WORDREMOVE) - 1)
End Function