I have a VBA code that's designed to search a CSV String and add Carriage Returns where they should exist. I've split it up into two seperate functions - one to search the string and put the index of where the CRs should go into an array and a second function to actually add the CRs.
The issue I'm running into is that the value in the immediate window/in the watch window for the functions is correct within the function itself, but it assigns the result variable a blank string.
'*****************Import CSV**********************
'Took this straight off the internet because it was reading Jet.com files as one single line
'
Sub ImportCSVFile(filepath As String)
.....
line = SearchString(line, "SALE")
.....
End Sub
'****************Search String***************************
'This is search the string for something - It will then call a function to insert carriage returns
Function SearchString(source As String, target As String) As String
Dim i As Integer
Dim k As Integer
Dim myArray() As Variant
Dim resultString As String
Do
i = i + 1
If Mid(source, i, Len(target)) = target Then
ReDim Preserve myArray(k)
myArray(k) = i
k = k + 1
End If
DoEvents
Loop Until i = Len(source)
resultString = addCarriageReturns(source, myArray) 'resultString here is assigned a blank string
SearchString = resultString
End Function
'***************Add Carraige Returns**************************
'Cycle through the indices held in the array and place carriage returns into the string
Function addCarriageReturns(source As String, myArray As Variant) As String
Dim i As Integer
Dim resultString As String
resultString = source
For i = 0 To UBound(myArray, 1)
resultString = Left(resultString, myArray(i) + i) & Chr(13) & Right(resultString, Len(resultString) - myArray(i) + i)
Next i
addCarraigeReturns = resultString 'The value of addCarriageReturn is correct in the immediate window here
End Function
In the function the value is not blank
...but when it passes it back, it says the value is blank
I'm just curious, why do you want separate functions like this?
Can you just use:
line = Replace(line, "SALE", "SALE" & Chr(13))
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'm using Access 2016. I have created a function that I've passed to a query - the function's role is to parse a memo (long text) field down from 3-4k characters (parses the string between 2 markers) to a length I can work with. Here is the function:
Function getBASE(sStrx)
Dim sTemp, iBEG As Integer, iEND As Integer, sBEG As String, sEND As String
'
If InStr(UCase(sStrx), "FROM ") > 1 And InStr(sStrx, "{") > 1 Then
iBEG = InStr(sStrx, "{") + 1
iEND = InStr(sStrx, "}") - iBEG
getBASE = Mid(sStrx, iBEG, iEND)
End If
'
End Function
The resultant length of this is around 700 characters. When I create a LEN on the result, I get 700 chars. I then run a sub (code below) that contains a Split function, but the result of the split is 255 characters. However, I have a couple of msgbox's that pop up to check the length of the recordset value and it's 700 (the correct length), but for some reason, it's truncating. I don't know if this is due the function, the sub, or something else. One other thing: I can pass the original value (3-4k chars) to the sub and it works fine. I'm beyond frustrated...thx for the help.
Sub Break_String()
Dim db As DAO.Database, rsSource As DAO.Recordset, rsDest As DAO.Recordset
Set db = CurrentDb()
Set rsSource = db.OpenRecordset("qTEST")
Set rsDest = db.OpenRecordset("tblParsed")
Dim WrdArray() As String
rsSource.MoveFirst
WrdArray() = Split(UCase(rsSource("[getBASE]")), "FROM ")
'
MsgBox Len(rsSource("[getBASE]")) <---- 700 chars
For i = LBound(WrdArray) To UBound(WrdArray)
strg = strg & vbNewLine & WrdArray(i)
Next i
'
MsgBox strg <----- 255 chars
End Sub
What I want to do is replace all 'A' in a string with "Bb". but it will only loop with the original string not on the new string.
for example:
AAA
BbAA
BbBbA
and it stops there because the original string only has a length of 3. it reads only up to the 3rd index and not the rest.
Dim txt As String
txt = output_text.Text
Dim a As String = a_equi.Text
Dim index As Integer = txt.Length - 1
Dim output As String = ""
For i = 0 To index
If (txt(i) = TextBox1.Text) Then
output = txt.Remove(i, 1).Insert(i, a)
txt = output
TextBox2.Text += txt + Environment.NewLine
End If
Next
End Sub
I think this leaves us looking for a String.ReplaceFirst function. Since there isn't one, we can just write that function. Then the code that calls it becomes much more readable because it's quickly apparent what it's doing (from the name of the function.)
Public Function ReplaceFirst(searched As String, target As String, replacement As String) As String
'This input validation is just for completeness.
'It's not strictly necessary.
'If the searched string is "null", throw an exception.
If (searched Is Nothing) Then Throw New ArgumentNullException("searched")
'If the target string is "null", throw an exception.
If (target Is Nothing) Then Throw New ArgumentNullException("target")
'If the searched string doesn't contain the target string at all
'then just return it - were done.
Dim foundIndex As Integer = searched.IndexOf(target)
If (foundIndex = -1) Then Return searched
'Build a new string that replaces the target with the replacement.
Return String.Concat(searched.Substring(0, foundIndex), replacement, _
searched.Substring(foundIndex + target.Length, searched.Length - (foundIndex + target.Length)))
End Function
Notice how when you read the code below, you don't even have to spend a moment trying to figure out what it's doing. It's readable. While the input string contains "A", replace the first "A" with "Bb".
Dim input as string = "AAA"
While input.IndexOf("A") > -1
input = input.ReplaceFirst(input,"A","Bb")
'If you need to capture individual values of "input" as it changes
'add them to a list.
End While
You could optimize or completely replace the function. What matters is that your code is readable, someone can tell what it's doing, and the ReplaceFirst function is testable.
Then, let's say you wanted another function that gave you all of the "versions" of your input string as the target string is replaced:
Public Function GetIterativeReplacements(searched As String, target As String, replacement As String) As List(of string)
Dim output As New List(Of String)
While searched.IndexOf(target) > -1
searched = ReplaceFirst(searched, target, replacement)
output.Add(searched)
End While
Return output
End Function
If you call
dim output as List(of string) = GetIterativeReplacments("AAAA","A","Bb")
It's going to return a list of strings containing
BbAAA, BbBbAA, BbBbBbA, BbBbBbBb
It's almost always good to keep methods short. If they start to get too long, just break them into smaller methods with clear names. That way you're not trying to read and follow and test one big, long function. That's difficult whether or not you're a new programmer. The trick isn't being able to create long, complex functions that we understand because we wrote them - it's creating small, simpler functions that anyone can understand.
Check your comments for a better solution, but for future reference you should use a while loop instead of a for loop if your condition will be changing and you're wanting to take that change into account.
I've made a simple example below to help you understand. If you tried the same with a for loop, you'd only get "one" "two" and "three" printed because the for loop doesn't 'see' that vals was changed
Dim vals As New List(Of String)
vals.Add("one")
vals.Add("two")
vals.Add("three")
Dim i As Integer = 0
While i < vals.Count
Console.WriteLine(vals(i))
If vals(i) = "two" Then
vals.Add("four")
vals.Add("five")
End If
i += 1
End While
If you do want to replace one by one instead of using the Replace function, you could use a while loop to look for the index of your search character/string, and then replace/insert at that index.
Sub Main()
Dim a As String = String.Empty
Dim b As String = String.Empty
Dim c As String = String.Empty
Dim d As Int32 = -1
Console.Write("Whole string: ")
a = Console.ReadLine()
Console.Write("Replace: ")
b = Console.ReadLine()
Console.Write("Replace with: ")
c = Console.ReadLine()
d = a.IndexOf(b)
While d > -1
a = a.Remove(d, b.Length)
a = a.Insert(d, c)
d = a.LastIndexOf(b)
End While
Console.WriteLine("Finished string: " & a)
Console.ReadLine()
End Sub
Output would look like this:
Whole string: This is A string for replAcing chArActers.
Replace: A
Replace with: Bb
Finished string: This is Bb string for replBbcing chBbrBbcters.
I was going to write a while loop to answer your question, but realized (with assistance from others) that you could just .replace(x,y)
Output.Text = Input.Text.Replace("A", "Bb")
'Input = N A T O
'Output = N Bb T O
Edit: There is probably a better alternative, but i quickly jotted this loop down, hope it helps.
You've said your new and don't fully understand while loops. So if you don't understand functions either or how to pass arguments to them, I'd suggest looking that up too.
This is your Event, It can be a Button click or Textbox text change.
'Cut & Paste into an Event (Change textboxes to whatever you have input/output)
Dim Input As String = textbox1.Text
Do While Input.Contains("A")
Input = ChangeString(Input, "A", "Bb")
' Do whatever you like with each return of ChangeString() here
Loop
textbox2.Text = Input
This is your Function, with 3 Arguments and a Return Value that can be called in your code
' Cut & Paste into Code somewhere (not inside another sub/Function)
Private Function ChangeString(Input As String, LookFor As Char, ReplaceWith As String)
Dim Output As String = Nothing
Dim cFlag As Boolean = False
For i As Integer = 0 To Input.Length - 1
Dim c As Char = Input(i)
If (c = LookFor) AndAlso (cFlag = False) Then
Output += ReplaceWith
cFlag = True
Else
Output += c
End If
Next
Console.WriteLine("Output: " & Output)
Return Output
End Function
I have written the following function to read all unique values from cells in a range and create a comma separated string from them? Is there a better, simpler way to do this?
Private Sub CsvUniqueValues(r As Excel.Range)
Dim c As Excel.Range
Dim s As String = ""
For Each c In r.Cells
If ExcelApp.WorksheetFunction.CountIf(r, c.Value) = 1 Then
s = s & ","
End If
Next
If s.Length > 0 Then
s = s.Substring(0, s.Length - 1)
End If
End Sub
You could use LINQ to get a list of only the unique values, like this:
Dim uniqueValues As IEnumerable = r.Cells.Where(Function(x) ExcelApp.WorksheetFunction.CountIf(r, x.Value) = 1))
Then, you could use LINQ to convert all of those unique values to strings:
Dim uniqueStrings As IEnumerable(Of String) = uniqueValues.Select(Of String)(Function(x) x.ToString())
Then you can use LINQ to convert the resulting list to an array:
Dim uniqueArray() As String = uniqueStrings.ToArray()
Then, you could use the String.Join method to combine them into a single CSV string:
Dim csv As String = String.Join(",", uniqueArray)
You could, of course, do all of this in a single command, like this:
Dim csv As String = String.Join(",",
r.Cells.Where(Function(x) ExcelApp.WorksheetFunction.CountIf(r, x.Value) = 1))
.Select(Of String)(Function(x) x.ToString())
.ToArray())
The question, though, is whether or not you would call that "easier". LINQ is useful because it makes code easier to to read and write, but when it's taken too far, it can become less readable, thereby defeating the purpose of using it. At the very least, to make your code more clear, I would move the first part into a named function so it's more self-documenting:
Public Function GetUniqueCellValuesAsString(r As Excel.Range) As IEnumerable(Of String)
Return r.Cells.Where(
Function(x) ExcelApp.WorksheetFunction.CountIf(r, x.Value) = 1))
.Select(Of String)(Function(x) x.ToString())
End Function
Then you could just build the CSV string like this:
Dim csv As String = String.Join(",", GetUniqueCellValuesAsString(r).ToArray())
I would make use of the collection object. Since collections can only contain unique values, trying to add all of your input data to a collection will result in an array of unique values. The following modification lets CsvUniqueValues return a comma separated string from the values in any given range.
'Test function and return result in MsgBox
Sub ReturnUnique()
MsgBox CsvUniqueValues(Selection)
End Sub
'Function will return csv-string from input range
Function CsvUniqueValues(r As Range) As String
Dim Cell As Range
Dim i As Integer
Dim DistCol As New Collection
Dim s As String
'Add all distinct values to collection
On Error Resume Next
For Each Cell In r
DistCol.Add Cell.Value, Cell.Value
Next Cell
On Error GoTo 0
'Write collection to comma seperated list
For i = 1 To DistCol.Count
s = s & DistCol.Item(i) & "; "
Next i
s = Left(s, Len(s) - 2)
CsvUniqueValues = s
End Function
What is the VBA string interpolation syntax? Does it exist?
I would to to use Excel VBA to format a string.
I have a variable foo that I want to put in a string for a range.
Dim row as Long
row = 1
myString = "$row:$row"
I would like the $row in the string to be interpolated as "1"
You could also build a custom Format function.
Public Function Format(ParamArray arr() As Variant) As String
Dim i As Long
Dim temp As String
temp = CStr(arr(0))
For i = 1 To UBound(arr)
temp = Replace(temp, "{" & i - 1 & "}", CStr(arr(i)))
Next
Format = temp
End Function
The usage is similar to C# except that you can't directly reference variables in the string. E.g. Format("This will {not} work") but Format("This {0} work", "will").
Public Sub Test()
Dim s As String
s = "Hello"
Debug.Print Format("{0}, {1}!", s, "World")
End Sub
Prints out Hello, World! to the Immediate Window.
This works well enough, I believe.
Dim row as Long
Dim s as String
row = 1
s = "$" & row & ":$" & row
Unless you want something similar to Python's or C#'s {} notation, this is the standard way of doing it.
Using Key\Value Pairs
Another alternative to mimic String interpolation is to pass in key\value pairs as a ParamArray and replace the keys accordingly.
One note is that an error should be raised if there are not an even number of elements.
' Returns a string that replaced special keys with its associated pair value.
Public Function Inject(ByVal source As String, ParamArray keyValuePairs() As Variant) As String
If (UBound(keyValuePairs) - LBound(keyValuePairs) + 1) Mod 2 <> 0 Then
Err.Raise 5, "Inject", "Invalid parameters: expecting key/value pairs, but received an odd number of arguments."
End If
Inject = source
' Replace {key} with the pairing value.
Dim index As Long
For index = LBound(keyValuePairs) To UBound(keyValuePairs) Step 2
Inject = Replace(Inject, "{" & keyValuePairs(index) & "}", keyValuePairs(index + 1), , , vbTextCompare)
Next index
End Function
Simple Example
Here is a simple example that shows how to implement it.
Private Sub testingInject()
Const name As String = "Robert"
Const age As String = 31
Debug.Print Inject("Hello, {name}! You are {age} years old!", "name", name, "age", age)
'~> Hello, Robert! You are 31 years old!
End Sub
Although this may add a few extra strings, in my opinion, this makes it much easier to read long strings.
See the same simple example using concatenation:
Debug.Print "Hello, " & name & "! You are " & age & " years old!"
Using Scripting.Dicitionary
Really, a Scripting.Dictionary would be perfect for this since they are nothing but key/value pairs. It would be a simple adjustment to my code above, just take in a Dictionary as the parameter and make sure the keys match.
Public Function Inject(ByVal source As String, ByVal data As Scripting.Dictionary) As String
Inject = source
Dim key As Variant
For Each key In data.Keys
Inject = Replace(Inject, "{" & key & "}", data(key))
Next key
End Function
Dictionary example
And the example of using it for dictionaries:
Private Sub testingInject()
Dim person As New Scripting.Dictionary
person("name") = "Robert"
person("age") = 31
Debug.Print Inject("Hello, {name}! You are {age} years old!", person)
'~> Hello, Robert! You are 31 years old!
End Sub
Additional Considerations
Collections sound like they would be nice as well, but there is no way of accessing the keys. It would probably get messier that way.
If using the Dictionary method you might create a simple factory function for easily creating Dictionaries. You can find an example of that on my Github Library Page.
To mimic function overloading to give you all the different ways you could create a main Inject function and run a select statement within that.
Here is all the code needed to do that if need be:
Public Function Inject(ByVal source As String, ParamArray data() As Variant) As String
Dim firstElement As Variant
assign firstElement, data(LBound(data))
Inject = InjectCharacters(source)
Select Case True
Case TypeName(firstElement) = "Dictionary"
Inject = InjectDictionary(Inject, firstElement)
Case InStr(source, "{0}") > 0
Inject = injectIndexes(Inject, CVar(data))
Case (UBound(data) - LBound(data) + 1) Mod 2 = 0
Inject = InjectKeyValuePairs(Inject, CVar(data))
Case Else
Err.Raise 5, "Inject", "Invalid parameters: expecting key/value pairs or Dictionary or an {0} element."
End Select
End Function
Private Function injectIndexes(ByVal source As String, ByVal data As Variant)
injectIndexes = source
Dim index As Long
For index = LBound(data) To UBound(data)
injectIndexes = Replace(injectIndexes, "{" & index & "}", data(index))
Next index
End Function
Private Function InjectKeyValuePairs(ByVal source As String, ByVal keyValuePairs As Variant)
InjectKeyValuePairs = source
Dim index As Long
For index = LBound(keyValuePairs) To UBound(keyValuePairs) Step 2
InjectKeyValuePairs = Replace(InjectKeyValuePairs, "{" & keyValuePairs(index) & "}", keyValuePairs(index + 1))
Next index
End Function
Private Function InjectDictionary(ByVal source As String, ByVal data As Scripting.Dictionary) As String
InjectDictionary = source
Dim key As Variant
For Each key In data.Keys
InjectDictionary = Replace(InjectDictionary, "{" & key & "}", data(key))
Next key
End Function
' QUICK TOOL TO EITHER SET OR LET DEPENDING ON IF ELEMENT IS AN OBJECT
Private Function assign(ByRef variable As Variant, ByVal value As Variant)
If IsObject(value) Then
Set variable = value
Else
Let variable = value
End If
End Function
End Function
Private Function InjectCharacters(ByVal source As String) As String
InjectCharacters = source
Dim keyValuePairs As Variant
keyValuePairs = Array("n", vbNewLine, "t", vbTab, "r", vbCr, "f", vbLf)
If (UBound(keyValuePairs) - LBound(keyValuePairs) + 1) Mod 2 <> 0 Then
Err.Raise 5, "Inject", "Invalid variable: expecting key/value pairs, but received an odd number of arguments."
End If
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Global = True
' Replace is ran twice since it is possible for back to back patterns.
Dim index As Long
For index = LBound(keyValuePairs) To UBound(keyValuePairs) Step 2
RegEx.Pattern = "((?:^|[^\\])(?:\\{2})*)(?:\\" & keyValuePairs(index) & ")+"
InjectCharacters = RegEx.Replace(InjectCharacters, "$1" & keyValuePairs(index + 1))
InjectCharacters = RegEx.Replace(InjectCharacters, "$1" & keyValuePairs(index + 1))
Next index
End Function
I have a library function SPrintF() which should do what you need.
It replaces occurrences of %s in the supplied string with an extensible number of parameters, using VBA's ParamArray() feature.
Usage:
SPrintF("%s:%s", 1, 1) => "1:1"
SPrintF("Property %s added at %s on %s", "88 High St, Clapham", Time, Date) => ""Property 88 High St, Clapham added at 11:30:27 on 25/07/2019"
Function SprintF(strInput As String, ParamArray varSubstitutions() As Variant) As String
'Formatted string print: replaces all occurrences of %s in input with substitutions
Dim i As Long
Dim s As String
s = strInput
For i = 0 To UBound(varSubstitutions)
s = Replace(s, "%s", varSubstitutions(i), , 1)
Next
SprintF = s
End Function
Just to add as a footnote, the idea for this was inspired by the C language printf function.
I use a similar code to that of #natancodes except that I use regex to replace the occurances and allow the user to specifiy description for the placeholders. This is useful when you have a big table (like in Access) with many strings or translations so that you still know what each number means.
Function Format(ByVal Source As String, ParamArray Replacements() As Variant) As String
Dim Replacement As Variant
Dim i As Long
For i = 0 To UBound(Replacements)
Dim rx As New RegExp
With rx
.Pattern = "{" & i & "(?::(.+?))?}"
.IgnoreCase = True
.Global = True
End With
Select Case VarType(Replacements(i))
Case vbObject
If Replacements(i) Is Nothing Then
Dim Matches As MatchCollection
Set Matches = rx.Execute(Source)
If Matches.Count = 1 Then
Dim Items As SubMatches: Set Items = Matches(0).SubMatches
Dim Default As String: Default = Items(0)
Source = rx.Replace(Source, Default)
End If
End If
Case vbString
Source = rx.Replace(Source, CStr(Replacements(i)))
End Select
Next
Format = Source
End Function
Sub TestFormat()
Debug.Print Format("{0:Hi}, {1:space}!", Nothing, "World")
End Sub