Ranking Variables 1

[twoody54]

Hi,

I have a question reguarding ranking variables so I can perform a calculation based on the most needed first, then second most needed etc. I am doing this in the code of a form.

I have eight Variables, just call them v1, v2,v3...etc

made up values
v1 v2 v3 v4 v5 v6 v7 v8
10 5 2 12 17 9 9 13

If you rank these in order this will make them:
v5-17
v8-13
v4-12
v1-10
v6-9
v8-9
v2-5
v3-2

Basically I need some code that will rank them by variable name so that it knows which variable needs the most work, in this instance v5. Once it knows that v5 is in most need it will perform a calculation, say add 35% of its total to a variable x.

so therefore x= v5 * .35 + x

I know I need a loop but I'm clueless as to how to creat this.

Any help would be greatly appreciated.

Thanks
Tom

 

[hwkranger]

i would make an array - use a bubble sort - then do the calculations.

I don't have time to type out a bubble sort, but if you have this problem tomorrow I'll get back to you. You can also use a search engine - type BUBBLE SORT and it'll give you a site that demonstrates this type of sort.

HOpe this helps

Cruz'n and Booz'n always.
This post shows what little I do at work.

 

[beetee]

An alternate method is to add sorted values:

Option Compare Database
Option Explicit

Function IntBinarySearch(IntArray() As Integer, ArrayEls As Integer, Sought As Integer, RetIndex As Integer) As Boolean
Dim Found As Boolean
RetIndex = 0
Found = False
If ArrayEls > 0 Then
Dim Top As Integer
Dim Bottom As Integer
Top = 0
Bottom = ArrayEls - 1
Do While Top <= Bottom
Dim Middle As Integer
Middle = Fix((Top + Bottom) / 2)
Dim CompValue As Integer
CompValue = IntArray(Middle) - Sought
If CompValue = 0 Then
RetIndex = Middle
Found = True
Exit Do
ElseIf CompValue < 0 Then
Top = Middle + 1
ElseIf CompValue > 0 Then
Bottom = Middle - 1
End If
Loop
If Not Found Then
RetIndex = Middle
If CompValue < 0 Then
RetIndex = RetIndex + 1
End If
End If
End If
IntBinarySearch = Found
End Function

Sub IntInsertSorted(NewEl As Integer, IntArray() As Integer, ArrayEls As Integer, ArraySize As Integer)
Dim InsertPos As Integer
If IntBinarySearch(IntArray, ArrayEls, NewEl, InsertPos) Then Exit Sub

If ArrayEls >= ArraySize Then
ArraySize = ArraySize + 8
ReDim Preserve IntArray(ArraySize)
End If

Dim Ix As Integer
Ix = ArrayEls - 1
Do While Ix >= InsertPos
IntArray(Ix + 1) = IntArray(Ix)
Ix = Ix - 1
Loop
IntArray(InsertPos) = NewEl
ArrayEls = ArrayEls + 1
End Sub


Sub TestIntSort()
Dim IntArray() As Integer
Dim ArrayEls As Integer
Dim ArraySize As Integer

Dim counter As Integer
For counter = 0 To 9
IntInsertSorted Rnd() * 500, IntArray, ArrayEls, ArraySize
Next counter

For counter = 0 To ArrayEls - 1
Debug.Print counter & &quot = &quot; & IntArray(counter)
Next counter
End Sub



You can change the 'integer' data type here to other types, e.g. strings, or even Controls (which I think would apply in your situation, as I suspect you are setting the variables from controls).

The control 'solution' is attractive because you can use the name property of the control to determine exactly which control had the largest value.



By the way, yet *another* solution is to simply check for max:

sub GetMaxOf(MaxVal as integer, CurVal as integer)
if curval > maxval then maxval = curval
end sub

you can call this repeatedly as needed.

HTH

 

[twoody54]

I can follow most of your code but I'm unsure how to implement it exactly. It's been a few years since I've done any real programming, esp VB. Sorry for my ignorance.

yes I am reading this off of controls. Each variable is attached to its own control, which are 8 text boxes with names ex: v1,v2,v3... v8.

I guess I just need the basic of how to call the functions using my controls...

Again, sorry for my ignorance.

Thanks
Tom

 

[beetee]

No problem:

here is a version to sort controls:

Option Compare Database
Option Explicit


Function CtrlBinarySearch(CtrlArray() As Control, ArrayEls As Integer, Sought As Control, RetIndex As Integer) As Boolean
Dim Found As Boolean
RetIndex = 0
Found = False
If ArrayEls > 0 Then
Dim Top As Integer
Dim Bottom As Integer
Top = 0
Bottom = ArrayEls - 1
Do While Top <= Bottom
Dim Middle As Integer
Middle = Fix((Top + Bottom) / 2)
Dim CompValue As Integer
CompValue = CtrlArray(Middle).Value - Sought.Value
If CompValue = 0 Then
RetIndex = Middle
Found = True
Exit Do
ElseIf CompValue < 0 Then
Top = Middle + 1
ElseIf CompValue > 0 Then
Bottom = Middle - 1
End If
Loop
If Not Found Then
RetIndex = Middle
If CompValue < 0 Then
RetIndex = RetIndex + 1
End If
End If
End If
CtrlBinarySearch = Found
End Function

Sub CtrlInsertSorted(NewEl As Control, CtrlArray() As Control, ArrayEls As Integer, ArraySize As Integer)
Dim InsertPos As Integer
If CtrlBinarySearch(CtrlArray, ArrayEls, NewEl, InsertPos) Then Exit Sub

If ArrayEls >= ArraySize Then
ArraySize = ArraySize + 8
ReDim Preserve CtrlArray(ArraySize)
End If

Dim Ix As Integer
Ix = ArrayEls - 1
Do While Ix >= InsertPos
Set CtrlArray(Ix + 1) = CtrlArray(Ix)
Ix = Ix - 1
Loop
Set CtrlArray(InsertPos) = NewEl
ArrayEls = ArrayEls + 1
End Sub




AND



here is some sample code to sort a set of controls.

It assumes that you have a naming convention, e.g. Ctrl1, Ctrl2, ... I added a sort button to my test form to do the sorting. In this example, there are 8 controls.

Private Sub SortButton_Click()
Dim CtrlArray() As Control
Dim ArrayEls As Integer
Dim ArraySize As Integer

Dim counter As Integer
For counter = 1 To 8
CtrlInsertSorted Me(&quot;Ctrl&quot; & counter), CtrlArray, ArrayEls, ArraySize
Next counter

For counter = 0 To ArrayEls - 1
Debug.Print CtrlArray(counter).name & &quot; = &quot; & CtrlArray(counter).Value
Next counter

End Sub

 

[twoody54]

Thanks, beetee! That worked to get the max value from those, but I will also need the second, third and fourth highest. Fifth through 8th don't matter. I should have been more specific with my first post.

What kind of modification would I need to do that? It's probably rather simple but I'm not completely sure.

Thanks
Tom

 

[beetee]

Assuming you have the sorted results, you can find the 1st, 2nd, 3rd... by looking at CtrlArray(0), CtrlArray(1), CtrlArray(2)

 

[twoody54]

ok that was my blonde moment for today. Thanks again. What's your address so I can send you a 6 pack? haha

 

[beetee]

just fax it to me dude! but thanks!

seriously, I like to look for interesting problems; and I keep the solutions in a toolbox (as it were) for later use. We all profit from this.

 

[twoody54]

Ok i've got my code working how I want it to now, but when I go to the next record and try to calc it gives me:

Run-time error '91':

Object variable or With block variable not set

Any clue what would cause this?

 

[twoody54]

I should specify that on the debug it will refer to me CtrlArray(x) where x is the 'position' I'm trying to get data from. It's as if it's not resorting or something and getting screwed up...

 

[beetee]

I tried creating a small test case, and I can't replicate the error you are getting...

Perhaps there is a null value in one of the controls.

try this:

Dim counter As Integer
For counter = 1 To 8
CtrlInsertSorted nz(Me(&quot;Ctrl&quot; & counter), 0), CtrlArray, ArrayEls, ArraySize
Next counter

 

[beetee]

OK, after giving it some thought, I realized that the code I gave you only saves *unique* values in the sorted array. Of course, you want to store *all* values.

So, use this code instead:


Function CtrlBinarySearch(CtrlArray() As Control, ArrayEls As Integer, Sought As Control, RetIndex As Integer) As Boolean
Dim Found As Boolean
RetIndex = 0
Found = False
If ArrayEls > 0 Then
Dim Top As Integer
Dim Bottom As Integer
Top = 0
Bottom = ArrayEls - 1
Do While Top <= Bottom
Dim Middle As Integer
Middle = Fix((Top + Bottom) / 2)
Dim CompValue As Integer
CompValue = CtrlArray(Middle).Value - Sought.Value
If CompValue = 0 Then
RetIndex = Middle
Found = True
Exit Do
ElseIf CompValue < 0 Then
Top = Middle + 1
ElseIf CompValue > 0 Then
Bottom = Middle - 1
End If
Loop
RetIndex = Middle
If Not Found Then
If CompValue < 0 Then
RetIndex = RetIndex + 1
End If
Else
Do While RetIndex < ArrayEls
CompValue = CtrlArray(RetIndex).Value - Sought.Value
If CompValue <> 0 Then Exit Do
RetIndex = RetIndex + 1
Loop
End If
End If
CtrlBinarySearch = Found
End Function

Sub CtrlInsertSorted(NewEl As Control, CtrlArray() As Control, ArrayEls As Integer, ArraySize As Integer)
Dim InsertPos As Integer
CtrlBinarySearch CtrlArray, ArrayEls, NewEl, InsertPos

If ArrayEls >= ArraySize Then
ArraySize = ArraySize + 8
ReDim Preserve CtrlArray(ArraySize)
End If

Dim Ix As Integer
Ix = ArrayEls - 1
Do While Ix >= InsertPos
Set CtrlArray(Ix + 1) = CtrlArray(Ix)
Ix = Ix - 1
Loop
Set CtrlArray(InsertPos) = NewEl
ArrayEls = ArrayEls + 1
End Sub

 

[twoody54]

That's exactly what the problem was thank you!