I have a text file with questions, one per line. I want powerpoint to randomly select a line from the file and put that line into a label. I would also like to make sure that each line would only be used once. If there is no easy way of going about this, maybe a way to delete the line that was selected from the text file. I found some code online but it won't do what I want (not using the same line twice).
Try this
Sub do_file()
Dim myArray
Open [YOUR TEXT FILE HERE] For Input As #1
fileinfo = Input(LOF(1), #1)
Close #1
myArray = Split(fileinfo, vbCrLf)
myArray = ShuffleArray(myArray)
For i = 0 To UBound(myArray)
[YOUR LABEL HERE] = myArray(i)
Next i
End Sub
Function ShuffleArray(OrigArray As Variant) As Variant
Dim RandNum As Long
Dim Holder As Variant
Dim ReturnArray() As Variant
ReDim ReturnArray(LBound(OrigArray) To UBound(OrigArray))
For i = LBound(OrigArray) To UBound(OrigArray)
ReturnArray(i) = OrigArray(i)
Next i
For i = LBound(OrigArray) To UBound(OrigArray)
RandNum = Int((UBound(OrigArray) - LBound(OrigArray)) * Rnd + LBound(OrigArray))
If i <> RandNum Then
Holder = ReturnArray(i)
ReturnArray(i) = ReturnArray(RandNum)
ReturnArray(RandNum) = Holder
End If
Next i
ShuffleArray = ReturnArray
End Function
This will read the file put each line into an array and then will Shuffle the array. It will then loop through the shuffled array which is where you will need to include your labels for output of the questions.
Related
I would like to repeatedly append an array of string values to a master array, which is initially empty. I cannot get it to append.
Sub main()
Dim num As Integer, root As String, pathToFile As String, allOf As Variant, someOf As Variant
Dim i As Integer, opts() As String, val As Integer
root = Application.ActiveWorkbook.Path
pathToFile = root & "\" & "name" & ".txt"
num = 5 ' the number of files I may have
For i = 0 To num - 1 ' loop over all the files
ReDim Preserve opts(i)
someOf = read_whole_file(pathToFile) ' read the file into variant
For val = LBound(someOf) To UBound(someOf) ' run through the array
' -- append someOf to allOf and loop
Dim Nmbr As Integer
On Error Resume Next
Err.Clear
If allOf.Value = "Empty" Then
Nmbr = UBound(allOf)
allOf(0) = someOf(0)
Else
ReDim Preserve allOf(UBound(allOf) + 1)
allOf(UBound(allOf)) = someOf(val)
End If
Next val
Next i
End Sub
Function read_whole_file(filePath As String) As Variant
Dim sWhole As String
Open filePath For Input As #1
sWhole = Input$(LOF(1), 1)
Close #1
read_whole_file = Split(sWhole, vbNewLine)
End Function
Contents of the text file :
"
Hello
This
Is a
Text
File
"
This is VBA. DOn't use an array use a collection.
Sub main()
Dim num As Integer, root As String, pathToFile As String, allOf As Collection, someOf As Variant
Set allof = new collection
Dim i As Integer, opts() As String, val As Variant
root = Application.ActiveWorkbook.Path
pathToFile = root & "\" & "name" & ".txt"
num = 5 ' the number of files I may have
For i = 0 To num - 1 ' loop over all the files
someOf = read_whole_file(pathToFile) ' read the file into variant
For Each val In someOf ' run through the array
alloff.Add val
Next
Next i
End Sub
In your code, you say you have 5 files:
num = 5 ' the number of files I may have
but you set the path_to_file immediately before this. More importantly, you do not change path_to_file within the loop, nor do you pass any modifier to read_whole_file. So you code will read from the same file 5 times.
You also don't set any value to allOf before you use it. You don't even identify what type it is (apart from Variant), so checking .Value is meaningless and should result in a compile error. Because of your On Error statement, that section is probably being ignored, thus the intended action is not occurring.
How to fix:
Add Option Explicit at the top of the module. Always.
Remove the On Error handling - if you think you may have some out of bounds issues, then cater for it in the program logic.
Bonus: Instead of ReDimming opts(I) each time in the loop, you already know how many iterations, so only ReDim it once before entering the loop.
I have a input file which I am struggling to read in line by line, The file can be found here and is also shown below:
I would like to add the first value as key and the third value as item in a dictonary
Then later I can do this: a = myDictonary("CREATED_BY") and this will then return "Eigil..." (Order and number of lines my vary from time to time..)
But somehow I can not get the split to work:
Dim hf As Integer: hf = FreeFile
Dim lines() As String, i As Long
Open FileName For Input As #hf
Line Input #hf, dataLine
lines = Split(dataLine, vbNewLine)
lines = Split(dataLine, "\n")
lines = Split(dataLine, "CR")
lines = Split(dataLine, "LF")
Close #hf
I also tried to follow this thread
For people who like to use dictinary here is my code for that:
Set getProjectDictionary = CreateObject("Scripting.Dictionary")
Dim item As String
Dim key As String
Dim dataLine As String
Open FileName For Input As 1
While Not EOF(1)
On Error Resume Next
Line Input #1, dataLine
temp = Split(dataLine, ",")
If Not temp(0) = "" Then
getProjectDictionary.Add temp(0), temp(3)
End If
Wend
Close 1
I added some debug output below:
The screenshot you attached shows that the file uses CR LF as linebreaks but the file I downloaded from your Google Drive link actually uses LF only, so you might want to use:
lines = Split(dataLine, vbLf)
Also, the file uses Little Endian UCS-2 encoding with BOM. If you simply open the file using the Open statement, you are likely to run into corrupt characters and other encoding related problems. I would suggest using Filesystem object instead.
I think this has the answer - split on vbcrlf?
CRLF in VBScript
Of the 4 examples you gave, "CR" and "LF" would look for the literal strings "CR" and "LF", which is not what you want. VB doesn't recognize "\n" like most C-like languages, so that's out. vbnewline was the closest to working, but I think this might help you:
http://www.jaypm.com/2012/08/the-difference-between-vbcrlf-vbnewline-and-environment-newline/
Here is my code that currently seems to work well:
Option Explicit
Sub test()
Dim a As Object
Set a = getPropertiesDictionary("c:\Temp\Creo\param_table.csv")
Debug.Print a.item("PTC_WM_CREATED_BY")
End Sub
' populate dictinoary with document types based on input file
Function getPropertiesDictionary(FileName As String) As Object
Set getPropertiesDictionary = CreateObject("Scripting.Dictionary")
Dim temp() As String
Dim dataLine As String
Dim hf As Integer: hf = FreeFile
Dim lines() As String, i As Long
Open FileName For Input As #hf
Line Input #hf, dataLine
lines = Split(dataLine, vbLf)
Close #hf
For i = 0 To UBound(lines) - 1
temp = Split(lines(i), ",")
If Not temp(0) = "" Then
getPropertiesDictionary.Add temp(0), temp(2)
End If
Next
End Function
I have this code but it have errors , what should i do ?
Dim lines As New List(Of String)
lines = RichTextBox1.Lines.ToList
'Dim FilterText = "#"
For i As Integer = lines.Count - 1 To 0 Step -1
'If (lines(i).Contains(FilterText)) Then
RichTextBox1.Lines(i) = RichTextBox1.Lines(i).Replace("#", "#sometext")
'End If
Next
RichTextBox1.Lines = lines.ToArray
Update: while the following "works" it does only modify the array which was returned from the Lines-property. If you change that array you don't change the text of the TextBox. So you need to re-assign the whole array to the Lines-property if you want to change the text(as shown below). So i keep the first part of my answer only because it fixes the syntax not the real issue.
It's not
RichTextBox1.Lines(i).Replace = "#sometext"
but
RichTextBox1.Lines(i) = "#sometext"
You can loop the Lines forward, the reverse loop is not needed here.
Maybe you want to replace all "#" with "#sometext" instead:
RichTextBox1.Lines(i) = RichTextBox1.Lines(i).Replace("#","#sometext")
So here the full code necessary (since it still seems to be a problem):
Dim newLines As New List(Of String)
For i As Integer = 0 To RichTextBox1.Lines.Length - 1
newLines.Add(RichTextBox1.Lines(i).Replace("#", "#sometext"))
Next
RichTextBox1.Lines = newLines.ToArray()
But maybe you could even use:
RichTextBox1.Text = RichTextBox1.Text.Replace("#","#sometext")`
because if we have # abcd this code change it to # sometextabcd ! I
Want a code to replace for example line 1 completely to # sometext
Please provide all relevant informations in the first place next time:
Dim newLines As New List(Of String)
For Each line As String In RichTextBox1.Lines
Dim newLine = If(line.Contains("#"), "#sometext", line)
newLines.Add(newLine)
Next
RichTextBox1.Lines = newLines.ToArray()
Using streamreader to read line by line of a text file. When I get to a certain line (i.e., 123|abc|99999||ded||789), I want to replace ONLY the first empty area with text.
So far, I've been toying with
If sLine.Split("|")(3) = "" Then
'This is where I'm stuck, I want to replace that index with mmm
End If
I want the output to look like this: 123|abc|99999|mmm|ded||789
Considering you already have code determining if the "mmm" string needs to be added or not, you could use the following:
Dim index As Integer = sLine.IndexOf("||")
sLine = sLine.Insert(index + 1, "mmm")
You could split the string, modify the array and rejoin it to recreate the string:
Dim sLine = "123|abc|99999||ded||789"
Dim parts = sLine.Split("|")
If parts(3) = "" Then
parts(3) = "mmm"
sLine = String.Join("|", parts)
End If
I gather that if you find one or more empty elements, you want to replace the first empty element with data and leave the rest blank. You can accomplish this by splitting on the pipe to get an array of strings, iterate through the array and replace the first empty element you come across and exit the loop, and then rejoin your array.
Sub Main()
Dim data As String = "123||abc|99999||ded||789"
Dim parts = data.Split("|")
For index = 0 To parts.Length - 1
If String.IsNullOrEmpty(parts(index)) Then
parts(index) = "mmm"
Exit For
End If
Next
data = String.Join("|", parts)
Console.WriteLine(data)
End Sub
Results:
123|mmm|abc|99999||ded||789
I have a text file with the format:
(title,price,id#)
CD1,11.00,111111
CD2,12.00,222222
CD3,13.00,333333
CD4,14.00,444444
CD5,15.00,555555
CD6,16.00,666666
What is the best way to go change the price of the appropriate CD if I'm given the id# and new price?
I'm sure it has something do to with getting the line and splitting it, but I'm not sure how I edit just one line and not mess up the whole file.
You can't rewrite a line without rewriting the entire file (unless the lines happen to be the same length). For such a small file it's probably the easiest to change the line in memory and then rewrite all to the file:
Dim idToFind = "444444"
Dim newPrice = "100"
Dim lines = IO.File.ReadAllLines(path)
For i = 0 To lines.Length - 1
Dim line = lines(i)
Dim fields = line.Split(","c)
If fields.Length > 2 Then
Dim id = fields(2)
If id = idToFind Then
Dim title = fields(0)
lines(i) = String.Format("{0},{1},{2}", title, newPrice, id)
Exit For
End If
End If
Next
IO.File.WriteAllLInes(path, lines)
Okay, now we know it's a short file, life becomes much easier:
Load the file into an array of lines using File.ReadAllLines
Find the right line using string.Split to split each line into the constituent parts, and check the ID.
When you've found the right line, replace it with the complete new line
Write the file back with File.WriteAllLines
That should be enough to get you going.
If its just a file with like 25 lines, you could do a simple input-transform-output routine and update the price per line.
Something like this (Using Streamreader / writer ).
Sub UpdatePrice(ByVal pricesToUpdate As Dictionary(Of Integer, String), ByVal inputPath As String)
If Not IO.File.Exists(inputPath) Then Return
Try
Using inputStream = New IO.StreamReader(inputPath, System.Text.Encoding.UTF8, True)
Using outputStream = New IO.StreamWriter(inputPath + ".tmp", False, System.Text.Encoding.UTF8)
While Not inputStream.EndOfStream
Dim inputLine = inputStream.ReadLine
Dim content = inputLine.Split(","c)
If Not content.Length >= 3 Then
outputStream.WriteLine(inputLine)
Continue While
End If
Dim id As Integer
If Not Integer.TryParse(content(2), id) Then
outputStream.WriteLine(inputLine)
Continue While
End If
If Not pricesToUpdate.ContainsKey(id) Then
outputStream.WriteLine(inputLine)
Continue While
End If
content(1) = pricesToUpdate(id)
outputStream.WriteLine(String.Join(",", {content(0), content(1), content(2)}))
End While
End Using
End Using
If IO.File.Exists(inputPath + ".tmp") Then
IO.File.Delete(inputPath)
IO.File.Move(inputPath + ".tmp", inputPath)
End If
Catch ex As IO.IOException
If IO.File.Exists(inputPath + ".tmp") Then IO.File.Delete(inputPath + ".tmp")
End Try
End Sub