Using Each in For Loop - for-loop

I'm trying to use the Each keyword in For loop to enter the values in an array, but I couldn't do it in the below code, could you help me understanding the error in below code.
Dim Arr(4)
For Each Element in Arr
Element = InputBox("Enter Data")
Next
'Nothing is getting stored in the Array: Arr()

You can't set an array element using the indexer returned from For Each (*), so you'll have to do something like this instead:
Dim Arr(4)
For i = 0 to 4
Arr(i) = InputBox("Enter Data")
Next
For Each Element in Arr
MsgBox Element
Next
(*) I would guess that it's a copy of the actual value

For each loop only works for a pre-existing array data. It cannot be used for assignments.
If in case, you need to use for each loop, you can use the following method:
Dim Arr(4)
i=0
For Each Element in Arr
Arr(i)= InputBox("Enter Data")
i++
Next
I am actually not aware of the syntax, but the following concept will help you in feeding the data in the array.

Related

Error: Input past end of the file?

I am working on VB Script and I am trying to read the txt file and sore it in a array.
I check for the number of lines and use that variable for the For loop.
I am getting an error Input past end of the file.
I am not sure how to solve this problem.
looking forward for your help.
Thank you!!
Dim num As Integer
'Skip lines one by one
Do While objTextFile.AtEndOfStream <> True
objTextFile.SkipLine ' or strTemp = txsInput.ReadLine
Loop
num = objTextFile.Line - 1
Dim para()
ReDim para(num)
For i = 1 To num
para(i) = objTextFile.ReadLine
Next
For two reasons (the second coming intp play if you fix the first):
You have already read the file to the end. You would need to reset or reopen it.
You are always reading 125 lines, regardless of how many lines you found.
You can read the lines and put them in the array in one go:
Dim para()
Dim num As Integer = 0
Do While Not objTextFile.AtEndOfStream
ReDim Preserve para(num)
para(num) = txsInput.ReadLine
num = num + 1
Loop
Note: Arrays are zero based, and the code above places the first line at index 0. If you place the data from index 1 and up (as in the original code) you leave the first item unused, and you have to keep skipping the first item when you use the array.
Edit:
I see that you changed 125 to num in the code, that would fix the second problem.
I've used the following style code which is fast for small files:
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(strList, ForReading)
strText = objTextFile.ReadAll
objTextFile.Close
arrList = Split(strText, vbCrLf)

How to get a string between 2 known words

My problem is to get a string as described above ! In my case
1234;0020001212;6565656AEBCD698798832
The string,I want is "0020001212" , My known words are ";".
I tried Mid() but my value is not stable , variable !
so, please help me to find this answer. Thank y
Explode it:
theLine = "1234;0020001212;6565656AEBCD698798832"
Dim arr() As String
arr = Split(theLine, ";")
Debug.Print arr(0)
Debug.Print arr(1)
Debug.Print arr(2)
For
1234
0020001212
6565656AEBCD698798832
Use the Split function and use ";" as the delimiter to convert the string into an array of strings.
Dim arr() As String
arr = Split("a;b;c", ";")
Then you can access the second element of the array to get your value.
Use split function, using ";" as separator

Count number of different values in chosen (large) range in VBA?

How can I count the number of different values (numbers and strings mixed) in a chosen (large) range in VBA?
I think about this in this way:
1. Read in data into one dimensional array.
2. Sort array (quick or merge sort) need to test which
3. Simply count number of different values if sorted array : if(a[i]<>a[i+1]) then counter=counter+1.
Is it the most efficient way to solve this problem?
Edit: I want to do it in Excel.
Here is a VBA Solution
You don't need an Array to get this done. You can also use a collection. Example
Sub Samples()
Dim scol As New Collection
With Sheets("Sheet1")
For i = 1 To 100 '<~~ Assuming the range is from A1 to A100
On Error Resume Next
scol.Add .Range("A" & i).Value, Chr(34) & _
.Range("A" & i).Value & Chr(34)
On Error GoTo 0
Next i
End With
Debug.Print scol.Count
'For Each itm In scol
' Debug.Print itm
'Next
End Sub
FOLLOWUP
Sub Samples()
Dim scol As New Collection
Dim MyAr As Variant
With Sheets("Sheet1")
'~~> Select your range in a column here
MyAr = .Range("A1:A10").Value
For i = 1 To UBound(MyAr)
On Error Resume Next
scol.Add MyAr(i, 1), Chr(34) & _
MyAr(i, 1) & Chr(34)
On Error GoTo 0
Next i
End With
Debug.Print scol.Count
'For Each itm In scol
' Debug.Print itm
'Next
End Sub
Instead of steps 2 and 3, perhaps you could use a Scripting.Dictionary and add each value to the dictionary. Any duplicate entries would cause a runtime error which you could either trap or ignore (resume next). Finally, you could then just return the dictionary's count which would give you the count of unique entries.
Here's a scrap of code I hurriedly threw together:
Function UniqueEntryCount(SourceRange As Range) As Long
Dim MyDataset As Variant
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
MyDataset = SourceRange
On Error Resume Next
Dim i As Long
For i = 1 To UBound(MyDataset, 1)
dic.Add MyDataset(i, 1), ""
Next i
On Error GoTo 0
UniqueEntryCount = dic.Count
Set dic = Nothing
End Function
I know that resume next can be considered a 'code smell', but the alternative could be to use the exists function of the dictionary to test whether the specified key already exists and then add the value if did not. I just have a feeling that when I did a similar thing in the past that it was faster to just ignore any errors raised for duplicate keys rather than using exists YMMY. For completeness, here's the other method using exists:
Function UniqueEntryCount(SourceRange As Range) As Long
Dim MyDataset As Variant
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
MyDataset = SourceRange
Dim i As Long
For i = 1 To UBound(MyDataset, 1)
if not dic.Exists(MyDataset(i,1)) then dic.Add MyDataset(i, 1), ""
Next i
UniqueEntryCount = dic.Count
Set dic = Nothing
End Function
Whilst the above code is simpler than your proposed method, it would be worth to test the performance of it against your solution.
Building on the idea presented by i_saw_drones, I strongly recommend the Scripting.Dictionary. However, this can be done without On Error Resume Next as shown below. Also, his example requires linking the Microsoft Scripting Runtime library. My example will demonstrate how to do this without needing to do any linking.
Also, since you're doing this in Excel, then you don't need to create the array in step 1 at all. The function below will accept a range of cells, which will be iterated through completely.
(i.e. UniqueCount = UniqueEntryCount(ActiveSheet.Cells) or UniqueCount = UniqueEntryCount(MySheet.Range("A1:D100"))
Function UniqueEntryCount(SourceRange As Range) As Long
Dim MyDataset As Variant
Dim MyRow As Variant
Dim MyCell As Variant
Dim dic As Object
Dim l1 As Long, l2 As Long
Set dic = CreateObject("Scripting.Dictionary")
MyDataset = SourceRange
For l1 = 1 To UBound(MyDataset)
' There is no function to get the UBound of the 2nd dimension
' of an array (that I'm aware of), so use this division to
' get this value. This does not work for >=3 dimensions!
For l2 = 1 To SourceRange.Count / UBound(MyDataset)
If Not dic.Exists(MyDataset(l1, l2)) Then
dic.Add MyDataset(l1, l2), MyDataset(l1, l2)
End If
Next l2
Next l1
UniqueEntryCount = dic.Count
Set dic = Nothing
End Function
It might also be important to note that the above will count a null string "" as a distinct value. If you do not want this to be the case, simply change the code to this:
For l1 = 1 To UBound(MyDataset)
For l2 = 1 To SourceRange.Count / UBound(MyDataset)
If Not dic.Exists(MyDataset(l1, l2)) And MyDataset(l1, l2) <> "" Then
dic.Add MyDataset(l1, l2), MyDataset(l1, l2)
End If
Next l2
Next l1
Sorry this is written in C#. This is how I would do it.
// first copy the array so you don't lose any data
List<value> copiedList = new List<value>(yourArray.ToList());
//for through your list so you test every value
for (int a = 0; a < copiedList.Count; a++)
{
// copy instances to a new list so you can count the values and do something with them
List<value> subList = new List<value>(copiedList.FindAll(v => v == copiedList[i]);
// do not do anything if there is only 1 value found
if(subList.Count > 1)
// You would want to leave 1 'duplicate' in
for (int i = 0; i < subList.Count - 1; i++)
// remove every instance from the array but one
copiedList.Remove(subList[i]);
}
int count = copiedList.Count; //this is your actual count
Have not tested it, please try.
You should wrap this inside a method so there is no messing around with the garbage. Otherwise you would lose the copy of the array only later. (return count)
EDIT: You need a list for this to work, use Array.ToList();

Read line-delimited data in VB6

So I have a number of text files that I'm trying to read with Visual Basic. They all have the same formatting:
[number of items in the file]
item 1
item 2
item 3
...etc.
What I'm trying to do is declare an array of the size of the integer in the first line, and then read each line into corresponding parts of the array (so item 1 would be array[0], item 2 would be array[1], etc. However, I'm not sure where to start on this. Any help would be appreciated.
Pretty basic stuff (no pun intended):
Dim F As Integer
Dim Count As Integer
Dim Items() As String
Dim I As Integer
F = FreeFile(0)
Open "data.txt" For Input As #F
Input #F, Count
ReDim Items(Count - 1)
For I = 0 To Count - 1
Line Input #F, Items(I)
Next
Close #F
try this for VB6
Dim file_id As Integer
Dim strline as string
Dim array_item() as string
'Open file
file_id = FreeFile
Open "C:\list.txt" For Input AS #file_id
Dim irow As Integer
irow = 0
'Loop through the file
Do Until EOF(file_id)
'read a line from a file
Line Input #file_id, strline
'Resize the array according to the line read from file
Redim Preserve array_item(irow)
'put the line into the array
array_item(irow) = strline
'move to the next row
irow = irow + 1
Loop
Close #file_id
The VB function you're looking for is "split":
http://www.vb-helper.com/howto_csv_to_array.html
Try this:
Dim FullText As String, l() As String
'''Open file for reading using Scripting Runtime. But you can use your methods
Dim FSO As Object, TS As Object
Set FSO = createbject("Scripting.FileSystemObject")
Set TS = createbject("Scripting.TextStream")
Set TS = FSO.OpenTextFile(FilePath)
TS.ReadLine 'Skip your first line. It isn't needed now.
'''Reading the contents to FullText and splitting to the array.
FullText = TS.ReadAll
l = Split(FullText, vbNewLine) '''the main trick
Splitting automatically resizes l() and stores all data.
Now the l() array has everything you want.

How do I declare global array in VBScript

I'm trying to store an array value so that I can reuse when Sub is called more than once.
I would like to prevent from reassigning values to the array if value exist.
My code is something like this.
Dim views()
Sub runit()
For i=0 To 3
test()
Next
End Sub
Sub test()
ReDim Preserve views(0)= "test"
' - other codes that I want to run-
End Sub
I get " Type mismatch :'choseviews'" error.
If I move "Dim views()" inside "Sub test", I don't get the error.
How do I declare global array in VBScript?
If it's not possible, is there any ways to prevent reassigning array when Sub is called?
This following code does not work but you may get an idea what I'm trying to do .
Dim views()
Sub runit()
For i=0 To 3
test()
Next
End Sub
Function IsArrayDimmed(arr)
IsArrayDimmed = False
If IsArray(arr) Then
On Error Resume Next
Dim ub : ub = UBound(arr)
If (Err.Number = 0) And (ub >= 0) Then IsArrayDimmed = True
End If
End Function
Sub test()
If IsArrayDimmed(views) Then
Else
ReDim Preserve views(0)= "test"
End If
' - other codes that I want to run-
End Sub
Thank you for your help.
If I understand correctly, it seems like you want to declare a global array variable, and then add items to that array, without being limited to a static number of elements. In other words, you need to dynamically increase the size of the array by re-allocating it.
The global declaration is correct and belongs where you have it:
Dim views()
What you wrote here is incorrect syntax, you cannot assign a value and ReDim at the same time.:
ReDim Preserve views(0)= "test"
Additionally, that would ReDim the array to size 0, which is the opposite of what you want.
If you wish to "push" values on that array you should use a function like this which handles the redim to increase the size of the array before adding the value to the tail of the array:
Function Push(ByRef arrTarget, ByVal varValue)
Dim intCounter
Dim intElementCount
ReDim Preserve arrTarget(UBound(arrTarget) + 1)
If (isObject(varValue)) Then
Set arrTarget(UBound(arrTarget)) = varValue
Else
arrTarget(UBound(arrTarget)) = varValue
End If
Push = arrTarget
End Function
Use it like this:
Call Push(views,"test")
Any variable instantiated in the global scope will be a "global" variable. However, you should pass that variable explicitly into other scopes "by reference" if you want to have any changes persist in the original scope. You can do that using the ByRef keword in your Function or Sub declaration.
Sub test(ByRef viewsArray)
Now within test you will reference viewsArray which acts as a pointer to views.

Resources