VBA Split data by new line word - vba

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.

Related

MS Access VBA: Split string into pre-defined width

I have MS Access form where the user pastes a string into a field {Vars}, and I want to reformat that string into a new field so that (a) it retains whole words, and (b) "fits" within 70 columns.
Specifically, the user will be cutting/pasting variable names from SPSS. So the string will go into the field as whole names---no spaces allowed---with line breaks between each variable. So the first bit of VBA code looks like this:
Vars = Replace(Vars, vbCrLf, " ")
which removes the line breaks. But from there, I'm stumped---ultimately I want the long string that is pasted in the Vars field to be put on consecutive multiple lines that each are no longer than 70 columns.
Any help is appreciated!
Okay, for posterity, here is a solution:
The field name on the form that captures the user input is VarList. The call to the SPSS_Syntax function below returns the list of variable names (in "Vars") that can then be used elsewhere:
Vars = SPSS_Syntax(me.VarList)
Recall that user input into Varlist comes in as each variable (word) with a line break in between each. The problem is that we want the list to be on one line (horizontal, not vertical) AND a line can be no more than 256 characters in length (I'm setting it to 70 characters below). Here's the function:
Public Function SPSS_Syntax(InputString As String)
InputString = Replace(InputString, vbNewLine, " ") 'Puts the string into one line, separated by a space.
MyLength = Len(InputString) 'Computes length of the string
If MyLength < 70 Then 'if the string is already short enough, just returns it as is.
SPSS_Syntax = InputString
Exit Function
End If
MyArray = Split(InputString, " ") 'Creates the array
Dim i As Long
For i = LBound(MyArray) To UBound(MyArray) 'for each element in the array
MyString = MyString & " " & MyArray(i) 'combines the string with a blank space in between
If Len(MyString) > 70 Then 'when the string gets to be more than 70 characters
Syntax = Syntax & " " & vbNewLine & MyString 'saves the string as a new line
MyString = "" 'erases string value for next iteration
End If
Next
SPSS_Syntax = Syntax
End Function
There's probably a better way to do it but this works. Cheers.

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

reverse some text in cell selected - VBA

I'm rooky for VBA. I have some problem about reversing my data on VBA-Excel. My data is "3>8 , 6>15 , 26>41 (each data on difference cells)" that i could reverse "3>8" to "8>3" follow my requirement by using function reverse. But i couldn't reverse "6>15" and "26>41" to "15>6" and "41>26". It will be "51>6" and "14>62" that failure, I want to be "15>6" and "41>26".
Reverse = StrReverse(Trim(str))
Help me for solve my issue please and thank for comment.
You first need to find the position of the ">" in the cell. you do this by taking the contents of the cell and treating it as a String and finding the ">"
This is done in the line beginning arrowPosition. This is the integer value of the position of the ">" in you original string
Next use Left to extract the text up to the ">" and Right to extract the text after the ">"
Then build a new String of rightstr & ">" & leftStr.
Note I input my data from Sheet1 B5 but you can just use any source as long as it is a String in the correct format.
Sub Test()
Dim myString As String
myString = Sheets("Sheet1").Range("B5")
Debug.Print myString
Debug.Print reverseString(myString)
End Sub
Function reverseString(inputString As String) As String
Dim leftStr As String
Dim rightStr As String
Dim arrowPosition As Integer
arrowPosition = InStr(1, inputString, ">")
leftStr = Left(inputString, arrowPosition - 1)
rightStr = Right(inputString, Len(inputString) - arrowPosition)
reverseString = rightStr & ">" & leftStr
End Function
just because you look for a VBA, you can add this function into your code:
Function rev(t As String) As String
s = Split(t, ">", 2)
rev = s(1) & ">" & s(0)
End Function
of course only if you have to reverse 2 number, otherwise you'll loop the "s", but the function would lose its usefulness

Excel VBA Custom Function Remove Words Appearing in One String From Another String

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

Get only the line of text that contains the given word VB2010.net

I have a text file on my website and I download the whole string via webclient.downloadstring.
The text file contains this :
cookies,dishes,candy,(new line)
back,forward,refresh,(new line)
mail,media,mute,
This is just an example it's not the actual string , but it will do for help purposes.
What I want is I want to download the whole string , find the line that contains the word that was entered by the user in a textbox, get that line into a string, then I want to use the string.split with as delimiter the "," and output each word that is in the string into an richtextbox.
Now here is the code that I have used (some fields are removed for privacy reasons).
If TextBox1.TextLength > 0 Then
words = web.DownloadString("webadress here")
If words.Contains(TextBox1.Text) Then
'retrieval code here
Dim length As Integer = TextBox1.TextLength
Dim word As String
word = words.Substring(length + 1) // the plus 1 is for the ","
Dim cred() As String
cred = word.Split(",")
RichTextBox1.Text = "Your word: " + cred(0) + vbCr + "Your other word: " + cred(1)
Else
MsgBox("Sorry, but we could not find the word you have entered", MsgBoxStyle.Critical)
End If
Else
MsgBox("Please fill in an word", MsgBoxStyle.Critical)
End If
Now it works and no errors , but it only works for line 1 and not on line 2 or 3
what am I doing wrong ?
It's because the string words also contains the new line characters that you seem to be omitting in your code. You should first split words with the delimiter \n (or \r\n, depending on the platform), like this:
Dim lines() As String = words.Split("\n")
After that, you have an array of strings, each element representing a single line. Loop it through like this:
For Each line As String In lines
If line.Contains(TextBox1.Text) Then
'retrieval code here
End If
Next
Smi's answer is correct, but since you're using VB you need to split on vbNewLine. \n and \r are for use in C#. I get tripped up by that a lot.
Another way to do this is to use regular expressions. A regular expression match can both find the word you want and return the line that contains it in a single step.
Barely tested sample below. I couldn't quite figure out if your code was doing what you said it should be doing so I improvised based on your description.
Imports System.Text.RegularExpressions
Public Class Form1
Private Sub ButtonFind_Click(sender As System.Object, e As System.EventArgs) Handles ButtonFind.Click
Dim downloadedString As String
downloadedString = "cookies,dishes,candy," _
& vbNewLine & "back,forward,refresh," _
& vbNewLine & "mail,media,mute,"
'Use the regular expression anchor characters (^$) to match a line that contains the given text.
Dim wordToFind As String = TextBox1.Text & "," 'Include the comma that comes after each word to avoid partial matches.
Dim pattern As String = "^.*" & wordToFind & ".*$"
Dim rx As Regex = New Regex(pattern, RegexOptions.Multiline + RegexOptions.IgnoreCase)
Dim M As Match = rx.Match(downloadedString)
'M will either be Match.Empty (no matching word was found),
'or it will be the matching line.
If M IsNot Match.Empty Then
Dim words() As String = M.Value.Split(","c)
RichTextBox1.Clear()
For Each word As String In words
If Not String.IsNullOrEmpty(word) Then
RichTextBox1.AppendText(word & vbNewLine)
End If
Next
Else
RichTextBox1.Text = "No match found."
End If
End Sub
End Class