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
Related
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 :)
How can I compare two entire multidimensional arrays in WinForms VB.NET?
My code is checking to see whether some Subs will change the content of an array.
In order to do this, it makes a carbon copy of the original array before the subs have been executed. This carbon copy is left untouched until after the sub has happened. Once it's done the Sub, I want to see whether anything in the main array has changed. Here's my current code:
If possible = "not possible" Then 'If grid is full
'Check whether something can be done at all
For x = 0 To 5
For y = 0 To 5
copyarray(x, y) = bigarray(x, y)
Next
Next
Dim movementarray() As String = {"up", "down", "left", "right"}
For i = 0 To 3
direction = movementarray(i)
moveblocks()
Next
If copyarray = bigarray Then
'This throws an error
End If
End If
N.B. copyarray is the carbon copy of bigarray; moveblocks() is the Sub which I want to see whether it changes anything; and possible is simply a prerequisite to this code being run.
How do I do this? I ask because Visual Basic throws the following error in respect to the last If statement:
Error 1: Operator '=' is not defined for types '2-dimensional array of Integer' and '2-dimensional array of Integer'. Use 'Is' operator to compare two reference types. My Game\Form1.vb Line 282 Character 16 My Program
Ok, I solved it. Here's my solution:
Private Function whatever() as Boolean
If possible = "not possible" Then 'If grid is full
'Check whether something can be done at all
For x = 0 To 5
For y = 0 To 5
copyarray(x, y) = bigarray(x, y)
Next
Next
Dim movementarray() As String = {"up", "down", "left", "right"}
For i = 0 To 3
direction = movementarray(i)
moveblocks()
Next
Dim changed as Boolean = False
For i = 0 to 5
For j = 0 to 5
If Not copyarray(i, j) = bigarray(i, j) Then Return True : Exit Function
Next
Next
Return False
End If
Return False
End Function
This code simply completes a shift of characters for every negative variable in the loop. It then displays this text for every loop completed. (The name variable is actually a parameter for one of the subroutines, so does need to remain being called 'variable')
Counter = 0
dim counterarray(24)
For variable = -1 to -25
completeshift()
displaytext()
counter = counter + 1
next
So in this code, i would like to know how to step up each variable in the array every time the loop is complete. Basically i need the first
loop displaytext() to go into counterarray(0), the second to go into counterarray(1) etc until all of them have been completed.
Not entirely sure what your question is, but if you want that loop to work you need to add step - 1
For variable = -1 to -25 step -1
completeshift()
displaytext()
counter = counter + 1
next
You are not using variable for anything so you may as well write,
Dim counterarray(24)
For i = 0 to 24
completeshift()
counterarray(i) = displaytext()
Next
probably too elaborate but ...
Dim count = 25
Dim counterArray(count - 1) As String
Enumerable.Range(0, count).Zip(Enumerable.Range(-count, count).Reverse(),
Function(counter, variable) counterArray(counter) = DisplayText())
This is a continuation of the question excel different SUM.IF array function, But since I've marked that as solved, I created a new question.
What I wanted there was a distinct sum of some values, and I have implemented #Marc's solution. However the report requirements have changed. I now need to exclude all values that are hidden, but still keep the original calculation method. Basicly i want to add a feature in the same way a SUBTOTAL(109, ref) would work.
To this I've created a simple VBA function CellIsNotHidden(Range), which returns 0 or 1 depending on the cell.
Therefore my best guess would be a formula like: {=SUM(IF($B1:$B7<>$B2:$B8,D2:D8,0)*CellIsNotHidden(D2:D8))}
But this function doesn't work, because CellIsNotHidden is not an array function.
How can I solve this?
In advance, thanks
Gunnar
Edit:
Thought I should include the simple VBA function:
Function CellIsNotHidden(InputRange As Range)
If InputRange.Cells.Height = 0 Then
CellIsNotHidden = 0
Else
If InputRange.Cells.Width = 0 Then
CellIsNotHidden = 0
Else
CellIsNotHidden = 1
End If
End If
End Function
Try this for UDF CellIsNotHidden. This will handle 1d (vector) and 2d arrays. Tested:
Function CellIsNotHidden(MyRange As Range) As Variant
Dim RootCell As Range
Dim tmpResult() As Long
Dim i As Long
Dim j As Long
On Error GoTo Whoops
ReDim tmpResult(0 To MyRange.Rows.Count - 1, 0 To MyRange.Columns.Count - 1)
Set RootCell = MyRange.Cells(1, 1)
For j = 0 To MyRange.Columns.Count - 1
For i = 0 To MyRange.Rows.Count - 1
tmpResult(i, j) = Not (RootCell.Offset(i, j).EntireColumn.hidden Or RootCell.Offset(i, j).EntireRow.hidden)
Next i
Next j
CellIsNotHidden = tmpResult
On Error GoTo 0
Exit Function
Whoops:
Debug.Print Err & " " & Error
End Function
Instead of using the UDF CellIsNotHidden(D2:D8) you could also try either of these:
SUBTOTAL(109,OFFSET(D2,ROW(D2:D8)-ROW(D2),))
SUBTOTAL(109,OFFSET(D2:D8,ROW(D2:D8)-MIN(ROW(D2:D8)),,1))
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 />"))