One line VBA statement expression with If-else condition - vba

I am creating an VBA-like expression.
Replace([EmailAddress], "#domain.com", , , "", , )
[EmailAddress] is actually consist of a string, for example "john.doe#domain.com". So the result generated from the expression will be "john.doe"
I would like to set a condition where, if the result returned from the expression is more than 20 characters, the result return will be "john.d".
Basically remove all the characters behind the first character after the symbol "."
The idea is something like:
Variable a = Replace([EmailAddress], "#domain.com", , , "", , )
If len(a) > 20 then
an expression that remove all the characters after the symbol "." and first letter
else
a
End if
I am not sure if I am making sense, as I am not a programmer and not sure if these VBA syntax used are correct. I think there should be a single line expression to accommodate all these conditions.
Really appreciate if someone can help to guide me.

Below is a short VBA function that accepts an email address. If there is an "#" in there, it gets the text to the left of it. If this text is longer than 20 characters and has a "." in it, then get all of the text to the left of the ".", plus the "." and the next character.
Function fRemoveDomain(strDomain As String) As String
If InStr(strDomain, "#") > 0 Then
fRemoveDomain = Left(strDomain, InStr(strDomain, "#") - 1)
If (Len(fRemoveDomain) > 20) And (InStr(fRemoveDomain, ".") > 0) Then
fRemoveDomain = Left(fRemoveDomain, InStr(fRemoveDomain, ".") + 1)
End If
End If
End Function
Regards,

This UDF should do the trick assuming the input of your email always follows the format where everything in brackets can be a string that does not contain # or .:
[name].[name]#[domain].com
Public Function DOMAIN(Target As String) As String
If Len(Split(Target, "#")(0)) > 20 Then
Domain = Split(Target, ".")(0) & "." & Left(Split(Target, ".")(1), 1)
Else
Domain = Split(Target, "#")(0)
End If
End Function
You can call your UDF right on the worksheet like so:
Or from a macro like so:
You can also avoid using VBA altogether with
=IF(LEN(MID(A2,1,SEARCH("#",A2)-1))>20,MID(A2,1,FIND(".",A2)+1),MID(A2,1,SEARCH("#",A2)-1))

Related

Remove all initial numbers from string until non-numerical character is reached

I am trying to remove the first numbers of a string of characters (remove all numbers until first non-numerical character is reached). Some strings have starting numbers formatted in the form of "14 214" where it should read 14214. This is the special space for separating numbers, and if the string in A1 starts by 14 214 then
ISNUMBER(LEFT(A1,3)*1)=TRUE
So that means that the space is not a problem, I just have to check for the first non-numerical character.
I thought of the following VBA function:
Function RemoveNumbers(Txt As String) As String
i = 1
Do While i < 9
If (IsError(Left(Txt, i) * 1)) = "False" Then
i = i + 1
Else
RemoveNumbers = Right(Txt, Len(Txt) - i)
End If
Loop
End Function
But it returns #VALUE!
Is the function correctly written? Do you have any suggestions?
Thanks
Walk along the string from left to right, looking at each character.
If the char is a space do nothing, if its a number replace it with a space otherwise return the string with leading spaces removed:
Function RemoveNumbers(txt As String) As String
Dim i As Long
For i = 1 To Len(txt)
Select Case Mid$(txt, i, 1)
Case " ":
Case "0" To "9": Mid$(txt, i, 1) = " "
Case Else
Exit For
End Select
Next
RemoveNumbers = LTrim$(txt)
End Function
Good solution from Alex K.
I would just like to add that the basic problem with the original program was that iserror does not catch the number conversion error - as soon as that occurs the whole function exits and you just get a value error because RemoveNumbers is not set. Also the error doesn't occur when you have left(txt,i)="14 ", but only on the next character when you have left(txt,i)="14 2". To make it work you would have to do something like this
Function RemoveNumbers(Txt As String) As String
On Error GoTo Handler
i = 1
Do While i <= Len(Txt)
firstNumber = Left(Txt, i) * 1
i = i + 1
Loop
Handler:
RemoveNumbers = Right(Txt, Len(Txt) - i + 1)
End Function

Excel VBA Using wildcard to replace string within string

I have a difficult situation and so far no luck in finding a solution.
My VBA collects number figures like $80,000.50. and I'm trying to get VBA to remove the last period to make it look like $80,000.50 but without using right().
The problem is after the last period there are hidden spaces or characters which will be a whole lot of new issue to handle so I'm just looking for something like:
replace("$80,000.50.",".**.",".**")
Is this possible in VBA?
I cant leave a comment so....
what about InStrRev?
Private Sub this()
Dim this As String
this = "$80,000.50."
this = Left(this, InStrRev(this, ".") - 1)
Debug.Print ; this
End Sub
Mid + Find
You can use Mid and Find functions. Like so:
The Find will find the first dot . character. If all the values you are collecting are currency with 2 decimals, stored as text, this will work well.
The formula is: =MID(A2,1,FIND(".",A2)+2)
VBA solution
Function getStringToFirstOccurence(inputUser As String, FindWhat As String) As String
getStringToFirstOccurence = Mid(inputUser, 1, WorksheetFunction.Find(FindWhat, inputUser) + 2)
End Function
Other possible solutions, hints
Trim + Clear + Substitute(Char(160)): Chandoo -
Untrimmable Spaces – Excel Formula
Ultimately, you can implement Regular expressions into Excel UDF: VBScript’s Regular Expression Support
How about:
Sub dural()
Dim r As Range
For Each r In Selection
s = r.Text
l = Len(s)
For i = l To 1 Step -1
If Mid(s, i, 1) = "." Then
r.Value = Mid(s, 1, i - 1) & Mid(s, i + 1)
Exit For
End If
Next i
Next r
End Sub
This will remove the last period and leave all the other characters intact. Before:
and after:
EDIT#1:
This version does not require looping over the characters in the cell:
Sub qwerty()
Dim r As Range
For Each r In Selection
If InStr(r.Value, ".") > 0 Then r.Characters(InStrRev(r.Text, "."), 1).Delete
Next r
End Sub
Shortest Solution
Simply use the Val command. I assume this is meant to be a numerical figure anyway? Get rid of commas and the dollar sign, then convert to value, which will ignore the second point and any other trailing characters! Robustness not tested, but seems to work...
Dim myString as String
myString = "$80,000.50. junk characters "
' Remove commas and dollar signs, then convert to value.
Dim myVal as Double
myVal = Val(Replace(Replace(myString,"$",""),",",""))
' >> myVal = 80000.5
' If you're really set on getting a formatted string back, use Format:
myString = Format(myVal, "$000,000.00")
' >> myString = $80,000.50
From the Documentation,
The Val function stops reading the string at the first character it can't recognize as part of a number. Symbols and characters that are often considered parts of numeric values, such as dollar signs and commas, are not recognized.
This is why we must first remove the dollar sign, and why it ignores all the junk after the second dot, or for that matter anything non numerical at the end!
Working with Strings
Edit: I wrote this solution first but now think the above method is more comprehensive and shorter - left here for completeness.
Trim() removes whitespace at the end of a string. Then you could simply use Left() to get rid of the last point...
' String with trailing spaces and a final dot
Dim myString as String
myString = "$80,000.50. "
' Get rid of whitespace at end
myString = Trim(myString)
' Might as well check if there is a final dot before removing it
If Right(myString, 1) = "." Then
myString = Left(myString, Len(myString) - 1)
End If
' >> myString = "$80,000.50"

Adding Logic for an Optional Argument in a Custom HL7 Parsing Function

I wrote a custom function that parses an HL7 interface message. These are messages sent between healthcare information systems, but basically it's just a long text string, delimited with various characters to indicate different fields, that I paste into a cell in Excel. The function I created searches and counts to find the fields specified in the arguments.
DISCLAIMER: I am new to VBA. I've been teaching myself via online research and trial-and-error over the past 3-4 weeks, so I'm no VBA expert. I'd prefer NOT to use arrays because when I tried that, the code got too complex for me to troubleshoot. So, I'm OK with the code being easy-to-follow, as opposed to being the fastest/most-efficient.
Anyhow, I've got it working pretty well to do what I want, but I'm stuck on adding in logic for an OPTIONAL argument.
So, this is how I WANT it to work:
Formula =KWHL7(A1, "MSH", 8)
NOTE only 3 arguments
Result I Want ADT^A08
Result I Get ADT
NOTE I know I told it to stop at the next instance of "HL7_SUBFIELD_DELIMITER" which is " ^ "
Formula =KWHL7(A1, "MSH", 8,1)
NOTE the optional 4th argument
Result I Want ADT
Formula =KWHL7(A1, "MSH", 8,2)
NOTE the optional 4th argument
Result I Want A08
The contents "value" of cell A1:
<11>MSH|^~\&|OPS|384|RISIC|384|20160923093012||ADT^A08|Q1230569238T1410271390|P|2.3|||*PM_ALLERGY*|||8859/1<13>
EVN||20160923<13>
PID|1||000000808^^^SCH MRN^MRN^SC||ZZTEST^LEANN||20160706|F|||459 CORPORATION ST.^^BEAVER^PA^15009^USA||(724)775-7418^PRN|||S||000000008082^^^SCH Account Number^FIN NBR|||||||0<13>
PV1|1|I|SCH Periop^^^^^^||||08888^Bullian^Leann~08888^Naylor^Daniel|||10|||||||08888^Nguyen-potter^Rose~00187^TEST^STCHRISRES^L^MD^^MD^^SCH Doc Number|1|1287593^^^TEMP FIN^VISITID||||||||||||||||||||384||A|||20160707131900<13>
PV2|||PA^<13>
OBX|1||Dosing Weight^WEIGHT||5|kg<13>
OBX|2||Height^HEIGHT||25|cm<13>
AL1|1|Drug|d00308^morphine^Multum Drug||66382015<13>
ZAL|||16655315|16655315||Active|66382015^Anaphylaxis^673967||||20160923093008|^Naylor^Daniel|0<13>
AL1|3|Drug|d00012^codeine^Multum Drug||103576018<13>
ZAL|||16655323|16655307||Active|103576018^Diarrhea^673967||||20160923093008|^Naylor^Daniel|0<13>
<28><13>
My VBA code (sorry for all the comments, I'm just learning!):
Public Function KWHL7(KW_Cell_With_HL7_Message As Variant, KW_HL7_Segment_Name As String, KW_HL7_Field_Number As Integer)
'KW_Cell_With_HL7_Message = KW_Cell_With_HL7_Message.Value
'KW_Cell_With_HL7_Message = ActiveCell.Value
'KW_HL7_Segment_Name = "PID"
'KW_HL7_Field_Number = 18
Const HL7_SEGMENT_DELIMITER = vbLf 'using "<13>" did not work due to carriage return
Const HL7_FIELD_DELIMITER = "|" ' Pipe means next field
Const HL7_SUBFIELD_DELIMITER = "^"
'Various carriage returns and line breaks: vbLf, vbCr, vbCrLf, vbNewLine, Chr(10), Chr(13)
KWSegmentStringToSearchFor = HL7_SEGMENT_DELIMITER & KW_HL7_Segment_Name 'Using the segment delimiter ("<13>" or "vbLf" / carriage return) before segment name implies that the segment / line STARTS with this text
KWSegmentCharacterPosition = InStr(1, KW_Cell_With_HL7_Message, KWSegmentStringToSearchFor)
'** FOR TESTING ** MsgBox ("Segment Character Position: " & KWSegmentCharacterPosition & ", 5 Characters starting there = " & Mid(KW_Cell_With_HL7_Message, KWSegmentCharacterPosition, 5))
'Now we have the character position of the start of the proper SEGMENT / line
'Now we have to find the Proper Field in that segment
'So we'll use this position + the length of the end of the Segment Delimiter as the start
'***WARNING***: Still must add logic to make sure we stop if we encounter another Segment Delimiter
KWFieldCharacterPosition = KWSegmentCharacterPosition + Len(HL7_SEGMENT_DELIMITER) 'instead of starting at character 0, start at the beginning of the segment found previously
' ** FOR TESTING ** MsgBox ("Length of Segment Delimiter = " & Len(HL7_SEGMENT_DELIMITER))
' ** FOR TESTING ** MsgBox ("Field Character Position: " & KWFieldCharacterPosition & ", 5 Characters starting there = " & Mid(KW_Cell_With_HL7_Message, KWFieldCharacterPosition, 5))
For J = 1 To KW_HL7_Field_Number
KWFieldCharacterPosition = InStr(KWFieldCharacterPosition + 1, KW_Cell_With_HL7_Message, HL7_FIELD_DELIMITER)
If KWFieldCharacterPosition = 0 Then Exit For
Next
' ** FOR TESTING ** MsgBox ("Field Character Position: " & KWFieldCharacterPosition & ", 5 Characters starting there = " & Mid(KW_Cell_With_HL7_Message, KWFieldCharacterPosition, 5))
'Determine the number of characters to return after the start position
'Want to pull text UNTIL the next Segment Delimiter or Field Delimiter or Subfield Delimiter
'Find the position of the next Segment Delimiter or Field Delimiter or Subfield Delimiter
'Since the InStr function does not accept multiple substrings to search for, and does not allow OR statements inside...
Next_HL7_Segment_Delimiter = InStr(KWFieldCharacterPosition + 1, KW_Cell_With_HL7_Message, HL7_SEGMENT_DELIMITER)
Next_HL7_Field_Delimiter = InStr(KWFieldCharacterPosition + 1, KW_Cell_With_HL7_Message, HL7_FIELD_DELIMITER)
Next_HL7_Subfield_Delimiter = InStr(KWFieldCharacterPosition + 1, KW_Cell_With_HL7_Message, HL7_SUBFIELD_DELIMITER)
'Added logic to handle issue where the next delimiter was not found, making result 0, making it the lowest value in the next lines of code
If Next_HL7_Segment_Delimiter = 0 Then Next_HL7_Segment_Delimiter = 99999
If Next_HL7_Field_Delimiter = 0 Then Next_HL7_Field_Delimiter = 99999
If Next_HL7_Subfield_Delimiter = 0 Then Next_HL7_Subfield_Delimiter = 99999
'Set the Last Character Position to whichever Next Delimiter is the lowest / minimum number - Segment or Field or Subfield
KWLastCharacterPosition = WorksheetFunction.Min(Next_HL7_Segment_Delimiter, Next_HL7_Field_Delimiter, Next_HL7_Subfield_Delimiter)
' ** FOR TESTING ** MsgBox ("Last Character Position: " & KWLastCharacterPosition & ", 5 Characters starting there = " & Mid(KW_Cell_With_HL7_Message, KWLastCharacterPosition, 5))
'Determine the number of characters to return in the MID function by subtracting the first character position from the last character position
KWNumberOfCharactersToReturn = KWLastCharacterPosition - KWFieldCharacterPosition - 1
' ** FOR TESTING ** MsgBox ("Number of characters to return: " & KWNumberOfCharactersToReturn)
KWResult = Mid(KW_Cell_With_HL7_Message, KWFieldCharacterPosition + 1, KWNumberOfCharactersToReturn)
'MsgBox ("Result: Segment " & KW_HL7_Segment_Name & ":" & KW_HL7_Field_Number & " is " & KWResult)
KWHL7 = KWResult
End Function
The problem I had with using the split function was that it put everything into arrays. And since I needed to search FIRST for the KWSegmentStringToSearchFor (i.e. "MSH" or "PV1"), before couting the pipe (|) characters, I would need the array to have separate nested arrays and it got way too confusing for me.
So I abandoned the split function, and my initial plans to use arrays, and just wrote everything to find things sequentially. So it searches for the KWSegmentStringToSearchFor (i.e. "MSH" or "PV1") with InStr() and then counts the pipe (|) characters from there to determine which number field to return.
Since the strings are of variable length, but delimited with special characters, next I have to determine how many characters to return with the MID function. So I search for the next delimiter FROM THERE / using the field I found as the starting point and call that the end of my field.
The issue:
The logic considers ANY of the 3 possible delimiters the end of the field.
If I take that out, the code wouldn't know where the end of the string is.
Even if I add some sort of IF statement that IF the optional 4th argument exists (which I'm not sure how to do yet), THEN ignore the ^ as a delimiter... that would always return the full field (ADT^A08). It wouldn't return just the sub-field / component I want.
Thanks!
A simple answer, would be to split on the LineFeed then it may need tweaking would be, split(range("a1").value,"|")(intFieldNumber)
i.e.
split("11>MSH|^~\&|OPS|384|RISIC|384|20160923093012||ADT^A08|Q1230569238T1410271390","|")(8)
gives the result ADT^A08

Visual Basic Replace is not working

I am writing a simple hangman program and I want to replace something in my variable which stores the letters of the word that have been found.
Here is the code:
Replace(wordLettersFound, Mid(wordLettersFound, counter, 1), letter)
wordLettersFound, counter and letter are 3 of the variables I am using.
The variable is all underscores before this script, but it does not change! Can anyone help me with this?
P.S.
I do not know what version of VB I am using, visual studio community 2015 just says 'visual basic'.
Replace doesn't modify the string but returns a new string with the replacement so you should assign it to the variable:
wordLettersFound = Replace(wordLettersFound, Mid(wordLettersFound, counter, 1), letter)
Another way to do replace,
Dim theLetters As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzAAA"
theLetters = theLetters.Replace("A"c, "#"c)
There is another way to replace a character in a string. Using the Replace function is a bit awkward in your case because, at the start, all the characters are underscores - Replace as you're using it will replace all of them with the found character.
Instead, you can cut up the string to the piece to the left of the desired replacement, add in the replacement character, and add on the rest of the string. That line is the one after the comment "chop foundWord up and put the character in the right place" in this code:
Module Module1
Sub Main()
Dim wordToFind = "alphabet"
' make a string of dashes the same length as the word to find
Dim foundWord = New String("-"c, wordToFind.Length)
While foundWord <> wordToFind
Console.Write("Enter your guess for a letter: ")
Dim guess = Console.ReadLine()
' make sure the user has only entered one character
If guess.Length = 1 Then
' see if the letter is in the string
Dim pos = wordToFind.IndexOf(guess)
While pos >= 0
' chop foundWord up and put the character in the right place
foundWord = foundWord.Substring(0, pos) & guess & foundWord.Substring(pos + 1)
' see if there are any more of the same letter
pos = wordToFind.IndexOf(guess, pos + 1)
End While
' show the user the current progress
Console.WriteLine(foundWord)
Else
Console.WriteLine("Please enter just one letter!")
End If
End While
Console.WriteLine("You did it!")
Console.WriteLine("Press enter to leave the program.")
Console.ReadLine()
End Sub
End Module
N.B. Do not use all that code directly for homework because your teacher will find this. And that goes to anyone else doing homework - you know who you are ;)

Removing characters with .Replace in VBA for Excel

The following function was given to me via an answer that I asked earlier today.
What I'm trying to do is to remove a character from a string in Excel using VBA. However, whenever the function runs, it ends up erasing the value stored and returning a #!VALUE error. I cannot seem to figure out what is going on. Anyone mind explaining an alternative:
Function ReplaceAccentedCharacters(S As String) As String
Dim I As Long
With WorksheetFunction
For I = 1 To Len(S)
Select Case Asc(Mid(S, I, 1))
' Extraneous coding removed. Leaving the examples which
' do work and the one that is causing the problem.
Case 32
S = .Replace(S, I, 1, "-")
Case 94
S = .Replace(S, I, 1, "/")
' This is the coding that is generating the error.
Case 34
S = .Replace(S, I, 1, "")
End Select
Next I
End With
ReplaceAccentedCharacters = S
End Function
When the string contains a " (or character code 34 in Decimal, 22 in Hexadecimal... I used both) it is supposed to remove the quotation mark. However, instead, Excel ignores it, and still returns the " mark anyway.
I then tried to go ahead and replace the .Replace() clause with another value.
Case 34
S = .Replace(S, I, 1, "/")
End Select
Using the code above, the script indeed does replace the " with a /.
I ended up finding the following example here in Stack Overflow:
https://stackoverflow.com/a/7386565/692250
And in the answer given, I see the same exact code example similar to the one that I gave and nothing. Excel is still ignoring the quotation mark. I even went so far as to expand the definition with curly braces and still did not get anything.
Try this:
Function blah(S As String) As String
Dim arr, i
'array of [replace, with], [replace, with], etc
arr = Array(Chr(32), "-", Chr(94), "/", Chr(34), "")
For i = LBound(arr) To UBound(arr) Step 2
S = Replace(S, arr(i), arr(i + 1))
Next i
blah = S
End Function
This function was designed to replace one character with another. It was not designed to replace a character with nothing. What happens when you try to replace a character with nothing is that the Counter for iterating through the word will now look (at the last iteration) for a character position that is greater than the length of the word. That returns nothing, and when you try to determine ASC(<nothing>) an error occurs. Other errors in the replacement routine will also occur when the length of the string is changed while the code is running
To modify the routine to replace a character with nothing, I would suggest the following:
In the Case statements:
Case 34
S = .Replace(S, I, 1, Chr(1))
And in the assignment statement:
ReplaceAccentedCharacters = Replace(S, Chr(1), "")
Note that VBA Replace is different from Worksheetfunction Replace