Remove front and back white space and insert single quote with comma - vba

Is there a way to trim the front and back, any white spaces, and give a single quote with a comma?
Value
12589ABC
A457892CD
564897ACC
ACT456734
BCD6589745
TA345TCFS
Expected Result
'12589ABC',
'A457892CD',
'564897ACC',
'ACT456734',
'BCD6589745',
'TA345TCFS',

Try doing the following find and replace, in regex mode:
Find: [ ]*(\S+)[ ]*
Replace: '$1',
Demo
Sample script:
Dim RegEx As Object
Dim Cell As Range
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Global = True
RegEx.Pattern = "[ ]*(\S+)[ ]*"
For Each Cell In Selection.Cells
Cell.Value = RegEx.Replace(Cell.Value, "'$1',")
Next

Related

Delete text enclosed in square brackets from a string

I have records that include text between square brackets.
aaaaaa[aaaaa]
I need to erase that text, square brackets included.
The result would be:
aaaaaa
I'm trying this code:
Dim sqr as Integer
Dim origin as String
Dim result as String
InStr(origin,[)
I can find the first square bracket, but it does not do the job.
Since in your question you state that you wish to remove text within square brackets (including removing the brackets), I would suggest the following:
Function RemoveSqBracketText(strStr As String) As String
Dim lngId1 As Long
Dim lngId2 As Long
lngId1 = InStr(strStr, "[")
lngId2 = InStr(strStr, "]")
If lngId1 > 0 And lngId2 > 0 Then
RemoveSqBracketText = Left(strStr, lngId1 - 1) & RemoveSqBracketText(Mid(strStr, lngId2 + 1))
Else
RemoveSqBracketText = strStr
End If
End Function
This will recursively remove all instances of text enclosed in square brackets, and assumes that you only wish to remove text if it is enclosed within an opening and closing bracket.
Examples:
?RemoveSqBracketText("abc[123]")
abc
?RemoveSqBracketText("abc[123]def[ghi]")
abcdef
?RemoveSqBracketText("abc[123]defghi]")
abcdefghi]
You need to work out the index of the opening square bracket - InStr(origin, "[") (note the double quotes) is a good start.
Now you can loop from that index up to the end of the string, using the Mid$ function to inspect the character at the current index, until the closing bracket is located:
Dim currentPosition As Long
currentPosition = InStr(origin, "[")
If currentPosition = 0 Then
' no opening bracket. now what?
Else
Dim bracketedWord As String
For currentPosition = currentPosition + 1 To Len(origin)
If Mid$(origin, currentPosition, 1) <> "]" Then
bracketedWord = bracketedWord & Mid$(origin, currentPosition, 1)
Else
'found the closing bracket: we're done.
Exit For
End If
Next
End If
Or, you can use InStr to locate the [ opening brace and the closing brace ] positions, then compute the length of the substring between these two positions, and use the Mid$ function to pull the substring without looping.
Alternatively, with a reference to Microsoft VBScript Regular Expressions 5.5 you could use a simple regular expression:
Public Function FindBracketedWord(ByVal value As String) As String
Dim regex As RegExp
Set regex = new RegExp
regex.Pattern = "\[(\w+)\]" ' matches a square-bracketed "word", no spaces
Dim matches As MatchCollection
Set matches = regex.Execute(value)
If matches.Count <> 0 Then result = matches(0).SubMatches(0)
FindBracketedWord = result
End Function

Split cells into 2 columns when any number

I can see numerous posts around this topic but none that specifically solves the problem I have.
I have a string that has text and numbers. I need to split the string into 2 columns when it first sees a number.
Example:
Ballyvic Boru5/6
First Drift2/1
Sizing Cusimanoin15/2
Becomes:
You can use a simple formula to find the first number, along with LEFT and MID to split the string.
Part 1:
=LEFT(A1,MIN(FIND({1,2,3,4,5,6,7,8,9,0},A1&"1234567890"))-1)
Part 2:
=MID(A1,MIN(FIND({1,2,3,4,5,6,7,8,9,0},A1&"1234567890")),99)
Here's a regex method:
You must set a reference to Microsoft VBScript Regular Expressions x.x, where x.x is the highest version you have (mine is 5.5)
Option Explicit
Sub splitCells()
Dim RegEx As New RegExp, i As Long, tempStr As String
With RegEx
.Global = True
.IgnoreCase = True
.Pattern = "(([a-z]*\s?)*\D)(\d.*)"
End With
With ThisWorkbook.Worksheets(1)
For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If RegEx.Test(.Cells(i, 1)) Then
tempStr = .Cells(i, 1)
.Cells(i, 1) = RegEx.Replace(tempStr, "$1")
.Cells(i, 2) = RegEx.Replace(tempStr, "$3")
End If
Next i
End With
End Sub
Breaking down the Regular Expression:
(([a-z]*\s?)*\D)(\d.*)
[a-z]* matches any character in the alphabet, with the * multiplier for unlimited occurances
\s? Matches any whitespace character, with the ? multiplier to match 0-1 occurances (meaning there may or may not be a white space
Both of the above is enclosed in a grouping (), followed by another * to match 0-unlimited occurances
\D This excludes all digits
The above is enclosed in a group with the first (([..])*\D)
We have our final group: (\d.*), which matches the first digit and everything else afterwards.
Here's a pair functions you can use on the worksheet (as opposed to having to run a VBA procedure to 'fix' the cells one time):
Public Function splitNum1(str As String) As String
Dim p
For p = 1 To Len(str)
If Mid(str, p, 1) Like "#" Then Exit For
Next
splitNum1 = Left(str, p - 1)
End Function
Public Function splitNum2(str As String) As String
splitNum2 = Right(str, Len(str) - Len(splitNum1(str)))
End Function
splitNum1 returns the string on the "left" side of the number.
splitNum2 returns the string beginning with the first nummber.

Removing All Spaces in String

I created a macro for removing all whitespace in a string, specifically an email address. However it only removes about 95% of the whitespace, and leaves a few.
My code:
Sub NoSpaces()
Dim w As Range
For Each w In Selection.Cells
w = Replace(w, " ", "")
Next
End Sub
Things I have tried to solve the issue include:
~ Confirmed the spaces are indeed spaces with the Code function, it is character 32 (space)
~ Used a substitute macro in conjuction with the replace macro
~ Have additional macro utilizing Trim function to remove leading and trailing whitespace
~ Made a separate macro to test for non-breaking spaces (character 160)
~ Used the Find and Replace feature to search and replace spaces with nothing. Confirmed working.
I only have one cell selected when I run the macro. It selects and goes through all the cells because of the Selection.Cells part of the code.
A few examples:
1 STAR MOVING # ATT.NET
322 TRUCKING#GMAIL.COM
ALEZZZZ#AOL. COM.
These just contain regular whitespace, but are skipped over.
Just use a regular expression:
'Add a reference to Microsoft VBScript Regular Expressions 5.5
Public Function RemoveWhiteSpace(target As String) As String
With New RegExp
.Pattern = "\s"
.MultiLine = True
.Global = True
RemoveWhiteSpace = .Replace(target, vbNullString)
End With
End Function
Call it like this:
Sub NoSpaces()
Dim w As Range
For Each w In Selection.Cells
w.Value = RemoveWhiteSpace(w.Value)
Next
End Sub
Try this:
Sub NoSpaces()
Selection.Replace " ", ""
End Sub
Use "Substitute"
Example...
=SUBSTITUTE(C1:C18," ","")
Because you assume that Selection.Cells includes all cells on the sheet.
Cells.Replace " ", ""
And to add to the excellent advice from all the great contributors, try the
TRIM or LTRIM, or RTRIM and you can read more about these functions here:
https://msdn.microsoft.com/en-us/library/office/gg278916.aspx
Now this does not remove embedded spaces (spaces in between the letters) but it will remove any leading and trailing spaces.
Hope this helps.
Space Problem with Excel
ok, the only way i see this two types of space is by converting their Ascii code value of which I do it here
now to explain this function i made, it will just filter the string character by character checking if its equal to the two types of space i mentioned. if not it will concatenate that character into the string which will be the final value after the loop. hope this helps. Thanks.
Function spaceremove(strs) As String
Dim str As String
Dim nstr As String
Dim sstr As String
Dim x As Integer
str = strs
For x = 1 To VBA.Len(str)
sstr = Left(Mid(str, x), 1)
If sstr = " " Or sstr = " " Then
Else
nstr = nstr & "" & sstr
End If
Next x
spaceremove = nstr
End Function
I copied a HTML table with data and pasted in excel but the cells were filled with unwanted space and all methods posted here didn't work so I debugged and I discovered that it wasn't actually space chars (ASCII 32) it was Non-breaking space) (ASCII 160) or HTML
So to make it work with that Non-breaking space char I did this:
Sub NoSpaces()
Dim w As Range
For Each w In Selection.Cells
w.Value = Replace(w.Value, " ", vbNullString)
w.Value = Replace(w.Value, Chr(160), vbNullString)
Next
End Sub

VBA check if a string follows pattern, space, two letters, six digits

I need to check if last 9 chars from cell follow a pattern.
The searched pattern is space two letters and six digits.
Cells contain some text then should have this pattern.
Usually searched cell content looks something like this:
"Tractor mowers PT009988"
Regards
Michał
This will test for this.
Public Function RegExTest(sCellContent As String) As String
Dim sContent As String, sMatch As Variant, i As Long
sContent = Right(sCellContent, 9)
With CreateObject("VBScript.RegExp")
.Global = True
.ignorecase = True
.Pattern = " [A-Za-z]{2}[0-9]{6}"
If .test(sContent) Then
Set sMatch = .Execute(sContent)
RegExTest = sMatch(i)
Exit Function
End If
End With
End Function
This is the pattern that needs to be matched:
" [A-Za-z]{2}[0-9]{6}"
1 Space, 2 letters (both upper case and lower case) and six digits.
If in range A1 is the value Tractor mowers PT009988 and you put this formula in B1 =RegExTest(A1) then the output in B1 will be PT009988.
If you don't care whether or not this is in the last 9 characters then change sContent = Right(sCellContent, 9) to sContent = sCellContent
Try this (if you want to include upper- and lower-case characters)
Dim c
For Each c In Selection
If c.Value Like "* [A-Z,a-z][A-Z,a-z]######" Then _
Debug.Print c.Value
Next c
https://msdn.microsoft.com/en-us/library/swf8kaxw.aspx

Not allow to use special characters within string

have some method which guard user to allow only letters, digits, - and single spaces. Saying letters i thought that letters only (a-z and A-Z) but without e.g ę, Ę, ą Ą, ś Ś, ż Ż etc... Can you please help me to fix my below code to check also that one? (not using regex)
For Each c As Char In txtSymbol.Text
If Not Char.IsLetterOrDigit(c) AndAlso c <> "-"c AndAlso c <> " " Then
MessageBox.Show("Only lower/upper letters, digits, - and single spaces are allowed"", "Warning", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Exit Try
End If
Next
For further discussion:
'--We elping user with leading and ending spaces to be removed and more than one space in same placed to be convert to only one space
Dim str As String = txtNazwa.Text.Trim 'deleting leading and ending spaces
While str.Contains(" ") 'deleting more than one space in same place
str = str.Replace(" ", " ")
End While
txtNazwa.Text = str 'corrected one we passed to textbox
'Now we checking further for only those can be presented to pass test:
'--> single space
'--> letters a-z A-Z
'--> digits
'--> -
Dim pattern As String = "^([a-zA-Z0-9-]+\s)*[a-zA-Z0-9-]+$"
Dim r As New Regex(pattern)
If Not r.IsMatch(str) Then
Exit Try
End If
You can try to use this regex:
^([a-zA-Z0-9-]+\s)*[a-zA-Z0-9-]+$
Regex Demo
In your code you can try it like this:
Dim str As String = "^[a-zA-Z0-9 ]*$"
Dim r As New Regex(str)
Console.WriteLine(r.IsMatch("yourInputString"))