Use only VBA - request for experts

M

Mark

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
 
K

keepitcool

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$1000>99)*($A$1:$A$1000<=125),($B$1:$B
$1000),0),1))")
p(2) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000>99)*($A$1:$A$1000<=125),($B$1:$B
$1000),0),2))")
p(3) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000>125)*($A$1:$A$1000<=140),($B$1:$B
$1000),0),1))")
p(4) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000>125)*($A$1:$A$1000<=140),($B$1:$B
$1000),0),2))")
p(5) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000>125)*($A$1:$A$1000<=140),($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$1000>99)*($A$1:$A$1000<=125),($B$1:$B
$1000),0),0))")
k(2) = Evaluate("=INDEX(A:A,MATCH(" & p( _
2) & ",IF(($A$1:$A$1000>99)*($A$1:$A$1000<=125),($B$1:$B
$1000),0),0))")
k(3) = Evaluate("=INDEX(A:A,MATCH(" & p( _
3) & ",IF(($A$1:$A$1000>126)*($A$1:$A$1000<=140),($B$1:$B
$1000),0),0))")
k(4) = Evaluate("=INDEX(A:A,MATCH(" & p( _
4) & ",IF(($A$1:$A$1000>126)*($A$1:$A$1000<=140),($B$1:$B
$1000),0),0))")
k(5) = Evaluate("=INDEX(A:A,MATCH(" & p( _
5) & ",IF(($A$1:$A$1000>126)*($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 said:
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
 
M

Mark

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$1000>99)*($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$1000>99)*($A$1:$A$1000<=125), ($B$1:$B
$1000),0),1))")
p(2) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000>99)*($A$1:$A$1000<=125), ($B$1:$B
$1000),0),2))")
p(3) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000>125)*($A$1:$A$1000<=140), ($B$1:$B
$1000),0),1))")
p(4) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000>125)*($A$1:$A$1000<=140), ($B$1:$B
$1000),0),2))")
p(5) = Evaluate( _
"=SUM(LARGE(IF(($A$1:$A$1000>125)*($A$1:$A$1000<=140), ($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$1000>99)*($A$1:$A$1000<=125),($B$1:$B
$1000),0),0))")
k(2) = Evaluate("=INDEX(A:A,MATCH(" & p( _
2) & ",IF(($A$1:$A$1000>99)*($A$1:$A$1000<=125),($B$1:$B
$1000),0),0))")
k(3) = Evaluate("=INDEX(A:A,MATCH(" & p( _
3) & ",IF(($A$1:$A$1000>126)*($A$1:$A$1000<=140), ($B$1:$B
$1000),0),0))")
k(4) = Evaluate("=INDEX(A:A,MATCH(" & p( _
4) & ",IF(($A$1:$A$1000>126)*($A$1:$A$1000<=140), ($B$1:$B
$1000),0),0))")
k(5) = Evaluate("=INDEX(A:A,MATCH(" & p( _
5) & ",IF(($A$1:$A$1000>126)*($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 said:
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

.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top