So I have data in format :
data1|data2|data3|data4|data5|data6|... etc.
I want Word to put enter (break line) after every 5th occurence of | in order to structure and separate data.
I cant find a simple and quick way to doing that. Any ideas?
Use the built-in Split function and rebuild the data string using the vbCrLf constant to add the line-feed.
Note that the Split function removes the delimiter, so if you need it in the output, you have to add it back when you add the strings in the For loop.
Something like the following could work:
Option Explicit
Sub GroupDataStringByFive()
Dim sIn As String
Dim sOut As String
Dim sArr() As String
Dim iForCounter As Integer
sIn = "data1|data2|data3|data4|data5|data6"
sArr = Split(sIn, "|")
If IsArray(sArr) Then
For iForCounter = 0 To UBound(sArr)
If iForCounter > 0 And iForCounter Mod 5 = 0 Then
sOut = sOut & vbCrLf & sArr(iForCounter)
Else
sOut = sOut & sArr(iForCounter)
End If
Next iForCounter
End If
MsgBox sOut
End Sub
Related
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.
This is the output of a program.
I have specified what shall be width of each cell in the program and my program shows correct output.
What I want to do is cell content shall be written from right to left. E.g highlighted figure 9983.54 has width of 21. Text file has used first 7 columns. But I want it to use last 7 columns of text file.
Please see expected output image.
I am not getting any clue how to do this. I am not a very professional programmer but I love coding. This text file is used as input to some other program and i am trying to automate writing text file from excel VBA.
Can anyone suggest a way to get this output format?
Here is the code which gave me first output
Option Explicit
Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As Integer)
Dim i As Long, j As Long
Dim strLine As String, strCell As String
'get a freefile
Dim fNum As Long
fNum = FreeFile
'open the textfile
Open strFile For Output As fNum
'loop from first to last row
'use 2 rather than 1 to ignore header row
For i = 1 To ws.Range("a65536").End(xlUp).Row
'new line
strLine = ""
'loop through each field
For j = 0 To UBound(s)
'make sure we only take chars up to length of field (may want to output some sort of error if it is longer than field)
strCell = Left$(ws.Cells(i, j + 1).Value, s(j))
'add on string of spaces with length equal to the difference in length between field length and value length
strLine = strLine & strCell & String$(s(j) - Len(strCell), Chr$(32))
Next j
'write the line to the file
Print #fNum, strLine
Next i
'close the file
Close #fNum
End Sub
'for example the code could be called using:
Sub CreateFile()
Dim sPath As String
sPath = Application.GetSaveAsFilename("", "Text Files,*.txt")
If LCase$(sPath) = "false" Then Exit Sub
'specify the widths of our fields
'the number of columns is the number specified in the line below +1
Dim s(6) As Integer
'starting at 0 specify the width of each column
s(0) = 21
s(1) = 9
s(2) = 15
s(3) = 11
s(4) = 12
s(5) = 10
s(6) = 186
'for example to use 3 columns with field of length 5, 10 and 15 you would use:
'dim s(2) as Integer
's(0)=5
's(1)=10
's(2)=15
'write to file the data from the activesheet
CreateFixedWidthFile sPath, ActiveSheet, s
End Sub
Something like this should work:
x = 9983.54
a = Space(21-Len(CStr(x))) & CStr(x)
Then a will be 14 spaces followed by x:
a = " 9983.54"
Here 21 is the desired column width --- change as necessary. CStr may be unnecessary for non-numeric x.
If you're going to right-justify a lot of different data to different width fields you could write a general purpose function:
Function LeftJust(val As String, width As Integer) As String
LeftJust = Space(width - Len(val)) & val
End Function
The you call it with LeftJust(CStr(9983.54), 21).
Also note that VBA's Print # statement has a Spc(n) parameter that you can use to produce fixed-width output, e.g., Print #fNum, Spc(n); a; before this statement you calculate n: n = 21-Len(CStr(a)).
Hope that helps
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
I have a macro I am trying to turn into a VBA Function or Query for adding leading zeros to a field.
For my circumstances, their needs to be 4 numeric digits plus any alphabetic characters that follow so a simple format query doesn't do the trick.
The macro I have uses Evaluate and =Match but I am unsure how this could be achieved in Access.
Sub Change_Number_Format_In_String()
Dim iFirstLetterPosition As Integer
Dim sTemp As String
For Each c In Range("A2:A100")
If Len(c) > 0 Then
iFirstLetterPosition = Evaluate("=MATCH(TRUE,NOT(ISNUMBER(1*MID(" & c.Address & ",ROW($1:$20),1))),0)")
sTemp = Left(c, iFirstLetterPosition - 1) 'get the leading numbers
sTemp = Format(sTemp, "0000") 'format the numbers
sTemp = sTemp & Mid(c, iFirstLetterPosition, Len(c)) 'concatenate the remainder of the string
c.NumberFormat = "#"
c.Value = sTemp
End If
Next
End Sub
In my database the field in need of formatting is called PIDNUMBER
EDIT:
To expand on why FORMAT doesnt work in my situation. Some PIDNUMBERS have an alpha character after the number that should not be counted when determining how many zeroes to add.
In example:
12 should become 0012
12A should become 0012A
When using format, it counts the letters as part of the string, so 12A would become 012A instead of 0012A as intended.
You could try:
Public Function customFormat(ByRef sString As String) As String
customFormat = Right("0000" & sString, 4 + Len(sString) - Len(CStr(Val(sString))))
End Function
Try utilize this function, if you only want this to be available in VBA, put Private in front of the Function:
Function ZeroPadFront(oIn As Variant) As String
Dim zeros As Long, sOut As String
sOut = CStr(oIn)
zeros = 4 - Len(sOut)
If zeros < 0 Then zeros = 0
ZeroPadFront = String(zeros, "0") & sOut
End Function
The Val() function converts a string to a number, and strips off any trailing non-numeric characters. We can use it to figure out how many digits the numeric portion has:
Function PadAlpha$(s$)
Dim NumDigs As Long
NumDigs = Len(CStr(Val(s)))
If NumDigs < 4 Then
PadAlpha = String$(4 - NumDigs, "0") & s
Else
PadAlpha = s
End If
End Function
? padalpha("12")
> 0012
? padalpha("12a")
> 0012a
Bill,
See if this will work. It seems like a function would better suit you.
Function NewPIDNumber(varPIDNumber As Variant) As String
Dim lngLoop As Long
Dim strChar As String
For lngLoop = 1 to Len(varPIDNumber)
strChar = Mid(varPIDNumber, lngLoop, 1)
If IsNumeric(strChar) Then
NewPIDNumber = NewPIDNumber & strChar
Else
Exit For
End If
Next lngLoop
If Len(NewPIDNumber) > 4 Then
MsgBox "Bad Data Maaaaan...." & Chr(13) & Chr(13) & "The record = " & varPIDNumber
Exit Function
End If
Do Until Len(NewPIDNumber) = 4
NewPIDNumber = "0" & NewPIDNumber
Loop
End Function
Data Result
012a 0012
12a 0012
12 0012
85 0085
85adfe 0085
1002a 1002
1002 1002
I have a file with a bunch of numbers in columns. These numbers are separated by a variable number of spaces. I want to skip the first line and get all the other lines and separate each number on the line. Finally, I want to write each number in Excel. I've been able to get the lines and write them on Excel but I can't separate each number (I'm getting the whole line as one string).
Does any body know how to split a string that has a variable number of spaces?
Here is my code.
Sub Test()
r = 0
With New Scripting.FileSystemObject
With .OpenTextFile("C:\Users\User\Desktop\File.tab", ForReading)
If Not .AtEndOfStream Then .SkipLine
Do Until .AtEndOfStream
ActiveCell.Offset(r, 0) = Split(.ReadLine, vbCrLf)
r = r + 1
Loop
End With
End With
End Sub
If you use the Excel worksheet function trim in place of the VBA function then excel will remove multiple spaces within a cell (not just from the left and right ends). Something like the below should solve the problem. I'm afraid I've not tested it as I haven't a copy of Excel handy.
Sub Test()
Dim splitValues As Variant
Dim i As Long
r = 0
With New Scripting.FileSystemObject
With .OpenTextFile("C:\Users\User\Desktop\File.tab", ForReading)
If Not .AtEndOfStream Then .SkipLine
Do Until .AtEndOfStream
ActiveCell.Offset(r, 0) = Split(.ReadLine, vbCrLf)
Application.Trim(ActiveCell.Offset(r, 0))
splitValues = Split(ActiveCell.Offset(r, 0), " ")
For i = 0 To UBound(x)
ActiveCell.Offset(r, i+1) = splitValues(i)
Next
Loop
r = r + 1
End With
End With