I am trying to run two WHILE NOT loops for a recordset. One of the loops counts the number of items whilst the other prints the results. I cannot alter the SQL query, so this is the counting method I'm left with.
setPeopleCount = 0
While NOT rsSetContents.EOF
setPeopleCount = setPeopleCount + 1
rsSetContents.MoveNext
Wend
While NOT rsSetContents.EOF
Response.Write rs.Fields("exampleItem")&"<br>"
rsSetContents.MoveNext
Wend
My problem is running the two loops. After the first loop has finished the count, the record cursor is at the end of the file, so when the next loop needs to run - it doesn't because EOF is true.
How can I reset the cursor back to the beginning of the file so the second loop can run?
You can use MoveFirst.
http://msdn.microsoft.com/en-us/library/windows/desktop/ms677527(v=vs.85).aspx
Could you not count on the bottom loop? Or perhaps read the records into an object array then you are free to iterate over it as many times as u want
The MoveFirst requires proper cursor on the recordset - if for example you'll change to different database the default cursor might change and the code might fail.
I would suggest you to store the values while counting, thus save the second loop:
setPeopleCount = 0
Dim exampleItems()
ReDim exampleItems(-1)
While NOT rsSetContents.EOF
setPeopleCount = setPeopleCount + 1
ReDim Preserve exampleItems(UBound(exampleItems) + 1)
exampleItems(UBound(exampleItems)) = rs("exampleItem")
rsSetContents.MoveNext
Wend
'instead of a loop, just this:
Response.Write(Join(exampleItems, "<br />"))
Related
I'm running into a problem with a block of code I'm trying to develop at my job. Essentially, I'm creating a userform in excel where folks will enter data for railcars as they get loaded at a certain location (we'll call these "spot 1, spot 2, spot 3, etc.").
Sometimes they'll have to move that car to a different spot, in which case I want them to be able to keep all the information on the railcar from the first/original entry, and then erase the data from the original spot once that's done.
To accomplish this in a more streamlined fashion, I've established arrays for each of the 5 spots that reference all the cells they're entering data into on the userform:
Dim spot1information(14)
spot1information(0) = UserForm.ProductType1.Value
spot1information(1) = UserForm.ProductID1.Value
spot1information(2) = UserForm.BatchID1.Value
etc....
Dim spot2information(14)
spot2information(0) = UserForm.ProductType2.Value
spot2information(1) = UserForm.ProductID2.Value
spot2information(2) = UserForm.BatchID2.Value
etc....
And so forth for all five spots. I don't know if this makes things more difficult, but note that these array values aren't all of the same type. For instance, index (0) will be a string, but index (10) is a DATETIME and index (12) is defined as Long.
So say that they are moving a car from spot 1 to spot 2. In short, I want the code to do the following:
Replace the values of indices 0 - 6 in spot2information (which is currently empty) with the values of indices 0 - 6 in spot1information (which the user has filled on the userform).
I'm only interested in carrying over indices 0-6 because they contain the pertinent railcar information
Empty every value of spot1information to ""
To accomplish this, I tried the following code and a few variations thereof:
If OriginalSpot.Value = 1 Then
If DestinationSpot.Value = 2 Then
For i = 0 to 6
spot2information(i) = spot1information(i)
Next
For Each i in spot1information
spot1information(i) = ""
Next
End If
End If
However, this keeps coming up with a type mismatch. I figure because the data in the spot2information array is empty, and the data in the spot1information array is not, but I'm not entirely sure of a way around this.
Update: I did what was suggested below and replaced: spot1information(i) = "" with Erase spot1information
The code now essentially works! The values of array "spot2information" are now the former values of "spot1information", with "spot1information" now empty.
The 2D array suggested below also works like a charm. New problem I've been facing is that array values are updating, but the userform isn't. (note: in the future I'll be posting this type of thing as a separate question, my apologies!)
Easier to manage this as a 2D array:
Sub Tester()
Dim spots(1 To 5, 0 To 14), n As Long, i As Long
'fill your spot arrays from the form....
For n = 1 To 5
spots(n, 0) = UserForm.Controls("ProductType" & n).Value
spots(n, 1) = UserForm.Controls("ProductID" & n).Value
spots(n, 2) = UserForm.Controls("BatchID" & n).Value
'etc etc
Next n
'swap a spot with another
Debug.Print spots(2, 1), spots(3, 1)
SwapSpots spots:=spots, fromSpot:=2, toSpot:=3
Debug.Print spots(2, 1), spots(3, 1)
End Sub
Sub SwapSpots(spots, fromSpot As Long, toSpot As Long)
Dim n As Long
For n = 0 To 6
spots(toSpot, n) = spots(fromSpot, n)
spots(fromSpot, n) = Empty 'empty the source slot value
Next n
End Sub
Assuming the DataType of the arrays is the same by Index i.e. index(0) is string for all spots, Index(2) is long for all spots, and so on.
If that is the case then this part should not produce any error:
For i = 0 to 6
spot2information(i) = spot1information(i)
Next
The error should be happening in this part more precisely in the line marked with #
For Each i in spot1information
spot1information(i) = "" '#
Next
and the reason for the error it seems to be that trying to assign a string value "" to a numeric type, given the "mismatch" error.
Using For Each i in spot1information indicates that you want to "Initiate" or Erase the entire array, therefore I suggest to use this line instead of the For…Next method.
Erase spot1information
In regards this:
But I've now run into a new problem, where the values on the userform haven't updated to reflect the new values stored in the array. Do I need to somehow "refresh" the userform?
You just updated the arrays, then you need to run the procedures used to update the values of the objects affected by both arrays in the UserForm.
I have created an array in which each element is a number of row I want to delete from the worksheet.
The only issue is that deleting rows from the top of the worksheet would shift position of other rows.
Therefore, please advise how to loop through the array from the bottom to the top (backwards).
(...)
For Each r In rowArray()
Cells(r, 5).Rows.EntireRow.Delete
Next r
(...)
For Each...Next loops vastly outperform For...Next loops for iterating object collections (source), and For...Next loops outperform For Each...Next loops for iterating an array. So, use a For loop if you're iterating an array, and a For Each loop it you're actually iterating the invidivual cells of a Range.
Consider using Union instead of iterating rows backwards, to join the rows you want to delete into a single Range object, which you an delete in a single worksheet operation - that will vastly outperform the backwards-loop.
Private Function Combine(ByVal source1 As Range, ByVal source2 As Range) As Range
If source1 Is Nothing Then
Set Combine = source2
Else
Set Combine = Union(source1, source2)
End If
End Function
Something like this (untested air-code):
Dim toDelete As Range, i As Long
For i = LBound(rowArray) To UBound(rowArray)
Set toDelete = Combine(toDelete, rowArray(i))
Next
If Not toDelete Is Nothing Then toDelete.EntireRow.Delete
That way toggling Application.Calculation to manual, disabling Application.EnableEvents and setting Application.ScreenUpdating to False will have little to no impact whatsoever on overall performance, because you're only interacting with the sheet when you have to, whereas deleting each row individually will fire worksheet events, prompt recalculations and screen repaints at every single iteration.
Use a counter loop and the step command:
Dim x as Integer
For x = 10 to 1 Step -1
myWorksheet.Rows(x).Delete
Next x
If you have numbers in an array, it would be something like:
For x = ubound(myArray) to 0 step -1
rows(myArray(x)).Delete
next x
Step is used to indicate how many iterations to jump, so you could use Step 2 for every other row, or Step -5 for every 5th row backwards.
Hello I have two dimensional array as below in LotusScript.
Counter = 0
While Not (ProcessingViewDoc Is Nothing )
Redim Preserve AllRecrods(Counter,0)
AllRecrods(Counter,0) = ProcessingViewDoc.Test1(0)
Redim Preserve AllRecrods(Counter,1)
AllRecrods(Counter,1) = ProcessingViewDoc.Test2(0)
Redim Preserve AllRecrods(Counter,2)
Set ProcessingViewDoc = ProcessingView.GetNextDocument(ProcessingViewDoc)
Counter = Counter +1
Wend
When It processes next document it does and reaches to counter 1 and second document it gives me error subscription out of range.
Here is global declaration of array.
Dim AllRecrods() As Variant
Here is the line when it gives error when it goes to loop second time.
Redim Preserve AllRecrods(Counter,0)
In addition to Richard's excellent answer, I would suggest a couple of things.
1) Instead of While Not (ProcessingViewDoc Is Nothing) (which contains two negatives, making it harder to read), use Do Until doc Is Nothing. It is much clearer.
2) If you use a list, you don't have to worry about redim of the array. You could make it a list of a custom data type, and if you use the UNID of the document as the key, you can quickly connect the values back to the originating document.
My code would look something like this:
--- Declarations ---
Type recordData
value1 As String
value2 As String
End Type
--- Main Code ---
Dim allRecords List As recordData
Dim unid as String
Do Until ProcessingViewDoc Is Nothing
unid = ProcessingViewDoc.UniqueID
allRecords(unid).value1 = ProcessingViewDoc.Test1(0)
allRecords(unid).value2 = ProcessingViewDoc.Test2(0)
Set ProcessingViewDoc = ProcessingView.GetNextDocument(ProcessingViewDoc)
Loop
You are using ReDim with the Preserve option and changing both of the dimensions. You can't do that.
From the documentation for the ReDim statement:
If Preserve is specified, you can change only the upper bound of the
last array dimension. Attempting to change any other bound results in
an error.
Also, the logic there is screwed up. You're doing three redims on every iteration, with the first one shrinking the second dimension back to zero on every iteration. Even if you weren't changing the first dimension, that would lose the data that you stored in AllRecrods( n ,1) because the preserve option can't keep data in a dimension that you shrink below the size that you've already used!
You should probably consider swapping your two dimensions, reversing them in your assignments, keeping the first dimension constant at 2, and eliminating two of your ReDim Preserve statements. I.e., just do one ReDim Preserve AllRecrods(2,counter) on each iteration of the loop.
I'm trying to work with a nested For loop. I essentially have 2 arrays and I want to use the 1st variable in array1 with the 1st variable in array2 to do some operation, and so on until the array is exhausted. Unfortunately, the Exit For, doesn't exit for the For levels. So I've tried to use a goTo command, however then I get an error of "This array is fixed or temporarily locked" clearly because I'm trying to re-access the array. I'm stuck how to get around this in VBA. Below is my code where at MsgBox some operation (that will need the pairs (dAFL,AFL),(dSF,SF), etc) will take place:
For Each vN In Array(dAFLcell, dSFcell, dSOcell, dFIGcell, dIBAcell, dIBXcell)
a = 0
For Each vN2 In Array(AFLcell, SFcell, SOcell, FIGcell, IBAcell, IBXcell)
If i = a Then
MsgBox a
GoTo end_of_for
End If
a = a + 1
Next vN2
end_of_for:
i = i + 1
Next vN
You could use a boolean flag - I don't know that it's the accepted method, but I use it from time to time.
Dim skipBool as Boolean = False
For Each vN In Array(dAFLcell, dSFcell, dSOcell, dFIGcell, dIBAcell, dIBXcell)
a = 0 'I think you want this out here, otherwise a will always equal 0
For Each vN2 In Array(AFLcell, SFcell, SOcell, FIGcell, IBAcell, IBXcell)
If Not skipBool Then 'run this stuff only if we don't want to skip it (duh!)
If i = a Then
MsgBox a
skipBool = True 'set skipBool to be True (we want to skip it!)
End If
a = a + 1
End If
Next vN2
i = i + 1
skipBool = False 'reset skipBool for the next go around
Next vN
I'm sure this code can be optimized a bit further (and to be honest, I haven't tested it), but it looks like this is what you're going for.
To be honest, the only problem might be that a = 0 was inside the second for loop, and that's why you weren't getting the results you expected. It's been a while since I've used VBA (I've only been using VB.NET), so I don't remember the exact syntax there. I'd try fixing that, and going back to the exit for method. If it still doesn't work, my code should.
Here's another possible approach:
Dim vn, Vn2 As Variant
Dim i, min As Integer
vn = Array(dAFLcell, dSFcell, dSOcell, dFIGcell, dIBAcell, dIBXcell)
Vn2 = Array(AFLcell, SFcell, SOcell, FIGcell, IBAcell, IBXcell)
If UBound(vn) <= UBound(Vn2) Then
min = UBound(vn)
Else
min = UBound(Vn2)
End If
For i = LBound(vn) To min
If vn(i) = Vn2(i) Then
MsgBox vn(i)
Exit For
End If
Next i
I always have trouble with Arrays which is why I usually avoid them but this time I'm trying to get my head round them
I'm trying to change the size of my Global Array inside vba
I have declared it using Public UseArr() As String
Now I've written a function that searches an SQL table and returns user information as a record set.
I want to take this record set and put it into my Global Array
This is the bit of code I've written for populating it
a = 0
If Not Not UseArr Then
For i = 0 To UBound(UseArr)
If StrComp(UseArr(i, 0), rs("Alias")) = 0 Then a = 1
Next i
b = i
Else
b = 0
End If
If a = 0 Then
ReDim Preserve UseArr(0 To b, 0 To 10)
With rs
If Not .BOF And Not .EOF Then
For j = 0 To 10
If Not rs(j) = "" Then
UseArr(b, j) = rs(j)
Else
UseArr(b, j) = "Null"
End If
Next j
End If
End With
End If
The idea being if the user is already in there it doesn't populate, and if not it populates.
It works fine for initialising the Array however when I go to put in a second user it throws a resize error.
Can anyone help?
Thanks in advance
Tom
Update with Dictionary Attempt
If UseList Is Nothing Then
Set UseList = New Dictionary
MsgBox "Created New"
End If
If UseList.Exists(rs("Alias")) Then
Dim temp()
For i = 0 To 10
temp(i) = rs(i + 1)
Next i
With UseList
.Add Key:=rs("Alias"), Item:=temp
End With
End If
Debug.Print UseList
You can only Redim Preserve the last dimension of a multi-dimensional array - see here. Have you considered using a Collection or Dictionary instead?
edit: using the code you've posted above, here's how you would display element 4 from the array associated with the key "tom"
MsgBox UseList("tom")(4)
or equivalently
MsgBox UseList.Item("tom")(4)
Here you have some explanation about how a Dictionary object works and some of its attributes and functions.
I think it's the best to reach your goal because they are so easy to use, fast and efficient.
First you have to import the mscorlib.dll into the Project References.
After you can use something like this to declare the dictionary:
Dim UseDict As Dictionary
Set UseDict = New Dictionary
To know if the Key you're searching is not in the Dictionary and then add the new user:
If Not UseDict.Exists(Key) Then
UseDict.Item(Key) = 1
End If
The Value is not important here, but if you wanted to count how many times a key appears somewhere, you could increment the value when UseDict.Exists(Key) = True.
That's what the Dictionaries, Hash-maps or Maps stand for: count and search efficiently.
Hope it helps!
I attach a code with some corrections. I think the problem is that you are trying to access to an array as if it was a variable. That means you have to loop through the item of a key.
I add comments to the code below:
Update
If UseList Is Nothing Then
Set UseList = New Dictionary
MsgBox "Created New"
End If
If UseList.Exists(rs("Alias")) Then
'i think is better to specify the data type and the dimension.
Dim temp(10) as string
'if you loop from 0 to 10 the array will have 11 elements
For i = 0 To 9
temp(i) = rs(i + 1)
Next i
'This will work also and looks nicer (in my opinion) than the method
'you pasted, but if that worked anyway don't change it ;)
UseList(rs("Alias")).Item = temp
End If
Now, if you want to retrieve the result you must:
For i = 0 To UBound(UseList.Item(rs("Alias")) - 1
Debug.Print UseList.Item(rs("Alias"))(i)
Next i
Give me feedback when you test the code, please :)