Use only VBA - request for experts
 

Hi,

I asked assistance, but I don't get sufficing solution.
Maybe, I inexactly describe problem. I don't know English
very well, and VBA either :)

My simplified problem look like this:

I have following table in first sheets:

Distance(km) Points
100 20,2
100 21,3
102 22,1
102 23,5
105 19,1
120 25,1
121 26,1
121 27,4
125 25,2
130 30,4
150 32,1
There are above is thousands records...

I'd like folowing only automatic result:

W = sum two of best points in range beetwen 100 and 125 km.
N = sum three of best points in range beetwen 126 and 140
km.
R = W + N [in points]
D = Total distance counted points [in km]
Necessary condition:
Total distance counted points must be minimum 600 km.

If fulfil necessary condition and R , D counted, then i'd
like do following table in another sheet (only VBA):

item Distance Points
1 (distance and points fulfil condition)
2 (distance and points fulfil condition)
3 (distance and points fulfil condition)
4 (distance and points fulfil condition)
5 (distance and points fulfil condition)
sum of total distance D = ...
sum of points R = ...

(3 rows empty)

item Distance Points
1 (distance and points fulfil condition)
2 (distance and points fulfil condition)
3 (distance and points fulfil condition)
4 (distance and points fulfil condition)
5 (distance and points fulfil condition)
sum of total distance D = ...
sum of points R = ...

etc....all case fulfil conditions



How could I do this only in VBA (without Solver)?
It's only simplified problem over, complex problem
probably was solved in Turbo Pascal.
I'd like VBA manage too.
Please help and give me complete solution in VBA.

Best Regards
Mark

Use only VBA - request for experts
 

Mark,

this works if regional settings have a DOT as decimal separator.

Sub Mark()
Dim p(1 To 5)
Dim k(1 To 5)
Dim w, r, ktot, i
p(1) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$100099)*($A$1:$A$1000<=12 5),($B$1:$B
$1000),0),1))")
p(2) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$100099)*($A$1:$A$1000<=12 5),($B$1:$B
$1000),0),2))")
p(3) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000125)*($A$1:$A$1000<=1 40),($B$1:$B
$1000),0),1))")
p(4) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000125)*($A$1:$A$1000<=1 40),($B$1:$B
$1000),0),2))")
p(5) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000125)*($A$1:$A$1000<=1 40),($B$1:$B
$1000),0),3))")
w = p(1) + p(2)
r = p(3) + p(4) + p(5)
k(1) = Evaluate("=INDEX(A:A,MATCH(" & p( _
1) & ",IF(($A$1:$A$100099)*($A$1:$A$1000<=125),($B$1:$ B
$1000),0),0))")
k(2) = Evaluate("=INDEX(A:A,MATCH(" & p( _
2) & ",IF(($A$1:$A$100099)*($A$1:$A$1000<=125),($B$1:$ B
$1000),0),0))")
k(3) = Evaluate("=INDEX(A:A,MATCH(" & p( _
3) & ",IF(($A$1:$A$1000126)*($A$1:$A$1000<=140),($B$1: $B
$1000),0),0))")
k(4) = Evaluate("=INDEX(A:A,MATCH(" & p( _
4) & ",IF(($A$1:$A$1000126)*($A$1:$A$1000<=140),($B$1: $B
$1000),0),0))")
k(5) = Evaluate("=INDEX(A:A,MATCH(" & p( _
5) & ",IF(($A$1:$A$1000126)*($A$1:$A$1000<=140),($B$1: $B
$1000),0),0))")
ktot = k(1) + k(2) + k(3) + k(4) + k(5)

For i = 1 To 5
Cells(i, 4) = p(i)
Cells(i, 5) = k(i)
Next
Cells(1, 6) = w
Cells(1, 7) = r
Cells(1, 8) = ktot
End Sub


keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Mark" wrote:

Hi,

I asked assistance, but I don't get sufficing solution.
Maybe, I inexactly describe problem. I don't know English
very well, and VBA either :)

My simplified problem look like this:

I have following table in first sheets:

Distance(km) Points
100 20,2
100 21,3
102 22,1
102 23,5
105 19,1
120 25,1
121 26,1
121 27,4
125 25,2
130 30,4
150 32,1
There are above is thousands records...

I'd like folowing only automatic result:

W = sum two of best points in range beetwen 100 and 125 km.
N = sum three of best points in range beetwen 126 and 140
km.
R = W + N [in points]
D = Total distance counted points [in km]
Necessary condition:
Total distance counted points must be minimum 600 km.

If fulfil necessary condition and R , D counted, then i'd
like do following table in another sheet (only VBA):

item Distance Points
1 (distance and points fulfil condition)
2 (distance and points fulfil condition)
3 (distance and points fulfil condition)
4 (distance and points fulfil condition)
5 (distance and points fulfil condition)
sum of total distance D = ...
sum of points R = ...

(3 rows empty)

item Distance Points
1 (distance and points fulfil condition)
2 (distance and points fulfil condition)
3 (distance and points fulfil condition)
4 (distance and points fulfil condition)
5 (distance and points fulfil condition)
sum of total distance D = ...
sum of points R = ...

etc....all case fulfil conditions



How could I do this only in VBA (without Solver)?
It's only simplified problem over, complex problem
probably was solved in Turbo Pascal.
I'd like VBA manage too.
Please help and give me complete solution in VBA.

Best Regards
Mark

Use only VBA - request for experts
 

Many thanks! Keepitcool is expert really.
I have a little confusion still..
It's work only when points are type of integer.

I had problem with dot and comma decimal either. Then Sub
Mark doesn't work.
Is there any way to by-pass it.

Function "Sep" don't produce effect.

k(1) = Evaluate("=INDEX(A:A,MATCH(" & Sep(p( _
1)) & ",IF(($A$1:$A$100099)*($A$1:$A$1000<=125),($B$1:$ B
$1000),0),0))")
etc...

Function Sep(p)
strM = ""
For d = 1 To Len(p)

sign = Mid(p, d, 1)
If sign = "," Then
sign = "."
End If
strM = strM & sign

Next d
p = strM

End Function

Regards
Mark

-----Original Message-----
Mark,

this works if regional settings have a DOT as decimal
separator.

Sub Mark()
Dim p(1 To 5)
Dim k(1 To 5)
Dim w, r, ktot, i
p(1) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$100099)*($A$1:$A$1000<=12 5),
($B$1:$B
$1000),0),1))")
p(2) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$100099)*($A$1:$A$1000<=12 5),
($B$1:$B
$1000),0),2))")
p(3) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000125)*($A$1:$A$1000<=1 40),
($B$1:$B
$1000),0),1))")
p(4) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000125)*($A$1:$A$1000<=1 40),
($B$1:$B
$1000),0),2))")
p(5) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000125)*($A$1:$A$1000<=1 40),
($B$1:$B
$1000),0),3))")
w = p(1) + p(2)
r = p(3) + p(4) + p(5)
k(1) = Evaluate("=INDEX(A:A,MATCH(" & p( _
1) & ",IF(($A$1:$A$100099)*($A$1:$A$1000<=125),($B$1:$ B
$1000),0),0))")
k(2) = Evaluate("=INDEX(A:A,MATCH(" & p( _
2) & ",IF(($A$1:$A$100099)*($A$1:$A$1000<=125),($B$1:$ B
$1000),0),0))")
k(3) = Evaluate("=INDEX(A:A,MATCH(" & p( _
3) & ",IF(($A$1:$A$1000126)*($A$1:$A$1000<=140),
($B$1:$B
$1000),0),0))")
k(4) = Evaluate("=INDEX(A:A,MATCH(" & p( _
4) & ",IF(($A$1:$A$1000126)*($A$1:$A$1000<=140),
($B$1:$B
$1000),0),0))")
k(5) = Evaluate("=INDEX(A:A,MATCH(" & p( _
5) & ",IF(($A$1:$A$1000126)*($A$1:$A$1000<=140),
($B$1:$B
$1000),0),0))")
ktot = k(1) + k(2) + k(3) + k(4) + k(5)

For i = 1 To 5
Cells(i, 4) = p(i)
Cells(i, 5) = k(i)
Next
Cells(1, 6) = w
Cells(1, 7) = r
Cells(1, 8) = ktot
End Sub


keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Mark" wrote:

Hi,

I asked assistance, but I don't get sufficing solution.
Maybe, I inexactly describe problem. I don't know
English
very well, and VBA either :)

My simplified problem look like this:

I have following table in first sheets:

Distance(km) Points
100 20,2
100 21,3
102 22,1
102 23,5
105 19,1
120 25,1
121 26,1
121 27,4
125 25,2
130 30,4
150 32,1
There are above is thousands records...

I'd like folowing only automatic result:

W = sum two of best points in range beetwen 100 and 125
km.
N = sum three of best points in range beetwen 126 and
140
km.
R = W + N [in points]
D = Total distance counted points [in km]
Necessary condition:
Total distance counted points must be minimum 600 km.

If fulfil necessary condition and R , D counted, then
i'd
like do following table in another sheet (only VBA):

item Distance Points
1 (distance and points fulfil condition)
2 (distance and points fulfil condition)
3 (distance and points fulfil condition)
4 (distance and points fulfil condition)
5 (distance and points fulfil condition)
sum of total distance D = ...
sum of points R = ...

(3 rows empty)

item Distance Points
1 (distance and points fulfil condition)
2 (distance and points fulfil condition)
3 (distance and points fulfil condition)
4 (distance and points fulfil condition)
5 (distance and points fulfil condition)
sum of total distance D = ...
sum of points R = ...

etc....all case fulfil conditions



How could I do this only in VBA (without Solver)?
It's only simplified problem over, complex problem
probably was solved in Turbo Pascal.
I'd like VBA manage too.
Please help and give me complete solution in VBA.

Best Regards
Mark

.