HosseinReihai
New Member
- Joined
- Dec 30, 2015
- Messages
- 5
Hello guys,
I have found the answer of a bunch of my questions through communicating in this website and hope this time be the same.
PROBLEM:
take some parameters (i) each with a minimum and maximum capacity. I have an amount of entry which can be assigned to each parameter so that at least an amount equal to minimum(i) assigned to parameter i and this amount must not exceed the maximum(i).
It is also need to respect this constraint that the priority of filling is with reaching all minimums. For example if we have 9 entry and parameter i and j has 3 and 2 for their minimum limits, first, we have put 3 of the entries into i and then 2 of the remaining into j so that the two minimums are respected. then for the 4 remaining entries will be assigned to each of the parameters respecting their maximum constriants.
I put it into a Do Loop but the loop never ended. the main code is below
I have found the answer of a bunch of my questions through communicating in this website and hope this time be the same.
PROBLEM:
take some parameters (i) each with a minimum and maximum capacity. I have an amount of entry which can be assigned to each parameter so that at least an amount equal to minimum(i) assigned to parameter i and this amount must not exceed the maximum(i).
It is also need to respect this constraint that the priority of filling is with reaching all minimums. For example if we have 9 entry and parameter i and j has 3 and 2 for their minimum limits, first, we have put 3 of the entries into i and then 2 of the remaining into j so that the two minimums are respected. then for the 4 remaining entries will be assigned to each of the parameters respecting their maximum constriants.
I put it into a Do Loop but the loop never ended. the main code is below
Code:
Do
If Jcounter > 11 Then
MsgBox "Jcounter more than 11 for es"
Exit Do
End
End If
If StProfile(Jcounter) = 0 Then
Select Case Jcounter
Case Is = "2"
If EChNamazi < Cells(3, 17).Value Then
StProfile(Jcounter) = 1
EChNamazi = EChNamazi + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
ElseIf EChNamazi >= Cells(3, 17) And EChNamazi < Cells(3, 16).Value Then
If EChDast >= Cells(3, 19).Value Then
If EBaby >= Cells(3, 21).Value Then
If EDigest >= Cells(3, 23).Value Then
If EInfect >= Cells(3, 25).Value Then
If EImmu >= Cells(3, 27).Value Then
If EKidny >= Cells(9, 17).Value Then
If EHeart >= Cells(9, 19).Value Then
If EGland >= Cells(9, 21).Value Then
If ENeuro >= Cells(9, 23).Value Then
If EDast >= Cells(9, 25).Value Then
StProfile(Jcounter) = 1
EChNamazi = EChNamazi + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Else
Jcounter = Jcounter + 1
End If
Case Is = "3"
If EChDast < Cells(3, 19).Value Then
StProfile(Jcounter) = 1
EChDast = EChDast + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
ElseIf EChDast >= Cells(3, 19).Value And EChDast < Cells(3, 18).Value Then
If EBaby >= Cells(3, 21).Value Then
If EDigest >= Cells(3, 23).Value Then
If EInfect >= Cells(3, 25).Value Then
If EImmu >= Cells(3, 27).Value Then
If EKidny >= Cells(9, 17).Value Then
If EHeart >= Cells(9, 19).Value Then
If EGland >= Cells(9, 21).Value Then
If ENeuro >= Cells(9, 23).Value Then
If EDast >= Cells(9, 25).Value Then
StProfile(Jcounter) = 1
EChDast = EChDast + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
End If
End If
End If
End If
End If
End If
End If
End If
End If
Else
Jcounter = Jcounter + 1
End If
Case Is = "4"
If EBaby < Cells(3, 21).Value Then
StProfile(Jcounter) = 1
EBaby = EBaby + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
ElseIf EBaby >= Cells(3, 21) And EBaby < Cells(3, 20).Value Then
If EDigest >= Cells(3, 23).Value Then
If EInfect >= Cells(3, 25).Value Then
If EImmu >= Cells(3, 27).Value Then
If EKidny >= Cells(9, 17).Value Then
If EHeart >= Cells(9, 19).Value Then
If EGland >= Cells(9, 21).Value Then
If ENeuro >= Cells(9, 23).Value Then
If EDast >= Cells(9, 25).Value Then
StProfile(Jcounter) = 1
EBaby = EBaby + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
End If
End If
End If
End If
End If
End If
End If
End If
Else
Jcounter = Jcounter + 1
End If
Case Is = "5"
If EDigest < Cells(3, 23).Value Then
StProfile(Jcounter) = 1
EDigest = EDigest + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
ElseIf EDigest >= Cells(3, 23) And EDigest < Cells(3, 22).Value Then
If EInfect >= Cells(3, 25).Value Then
If EImmu >= Cells(3, 27).Value Then
If EKidny >= Cells(9, 17).Value Then
If EHeart >= Cells(9, 19).Value Then
If EGland >= Cells(9, 21).Value Then
If ENeuro >= Cells(9, 23).Value Then
If EDast >= Cells(9, 25).Value Then
StProfile(Jcounter) = 1
EDigest = EDigest + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
End If
End If
End If
End If
End If
End If
End If
Else
Jcounter = Jcounter + 1
End If
Case Is = "6"
'To avoid over allocation
If StProfile(13) < 1 Then
If EInfect < Cells(3, 25).Value Then
StProfile(Jcounter) = 1
EInfect = EInfect + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
'Offoni assignments are i month period, not 15 days ones
StProfile(13) = StProfile(13) + 2
Exit Do
ElseIf EInfect >= Cells(3, 25).Value And EInfect < Cells(3, 24).Value Then
If EImmu >= Cells(3, 27).Value Then
If EKidny >= Cells(9, 17).Value Then
If EHeart >= Cells(9, 19).Value Then
If EGland >= Cells(9, 21).Value Then
If ENeuro >= Cells(9, 23).Value Then
If EDast >= Cells(9, 25).Value Then
StProfile(Jcounter) = 1
EInfect = EInfect + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 2
Exit Do
End If
End If
End If
End If
End If
End If
Else
Jcounter = Jcounter + 1
End If
Else
Jcounter = Jcounter + 1
End If
Case Is = "7"
If EImmu < Cells(3, 27).Value Then
StProfile(Jcounter) = 1
EImmu = EImmu + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
ElseIf EImmu >= Cells(3, 27).Value And EImmu < Cells(3, 26).Value Then
If EKidny >= Cells(9, 17).Value Then
If EHeart >= Cells(9, 19).Value.Value Then
If EGland >= Cells(9, 21).Value Then
If ENeuro >= Cells(9, 23).Value Then
If EDast >= Cells(9, 25).Value Then
StProfile(Jcounter) = 1
EImmu = EImmu + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
End If
End If
End If
End If
End If
Else
Jcounter = Jcounter + 1
End If
Case Is = "8"
If EKidny < Cells(9, 17).Value Then
StProfile(Jcounter) = 1
EKidny = EKidny + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
ElseIf EKidny >= Cells(9, 17).Value And EKidny < Cells(9, 16).Value Then
If EHeart >= Cells(9, 19).Value Then
If EGland >= Cells(9, 21).Value Then
If ENeuro >= Cells(9, 23).Value Then
If EDast >= Cells(9, 25).Value Then
StProfile(Jcounter) = 1
EKidny = EKidny + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
End If
End If
End If
End If
Else
Jcounter = Jcounter + 1
End If
Case Is = "9"
If EHeart < Cells(9, 19).Value Then
StProfile(Jcounter) = 1
EHeart = EHeart + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
ElseIf EHeart >= Cells(9, 19) And EHeart < Cells(9, 18).Value Then
If EGland >= Cells(9, 21).Value Then
If ENeuro >= Cells(9, 23).Value Then
If EDast >= Cells(9, 25).Value Then
StProfile(Jcounter) = 1
EHeart = EHeart + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
End If
End If
End If
Else
Jcounter = Jcounter + 1
End If
Case Is = "10"
If EGland < Cells(9, 21).Value Then
StProfile(Jcounter) = 1
EGland = EGland + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
ElseIf EGland >= Cells(9, 21).Value And EGland < Cells(9, 20).Value Then
If ENeuro >= Cells(9, 23).Value Then
If EDast >= Cells(9, 25).Value Then
StProfile(Jcounter) = 1
EGland = EGland + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
End If
End If
Else
Jcounter = Jcounter + 1
End If
Case Is = "11"
If ENeuro < Cells(9, 23).Value Then
StProfile(Jcounter) = 1
ENeuro = ENeuro + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
ElseIf ENeuro >= Cells(9, 23).Value And ENeuro < Cells(9, 22).Value Then
If EDast >= Cells(9, 25).Value Then
StProfile(Jcounter) = 1
ENeuro = ENeuro + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
End If
Else
Jcounter = Jcounter + 1
End If
Case Is = "12"
If EDast < Cells(9, 24).Value Or EDast < Cells(9, 25).Value Then
StProfile(Jcounter) = 1
EDast = EDast + 1
activecell.Offset(0, Jcounter).Font.Color = vbRed
StProfile(13) = StProfile(13) + 1
Exit Do
Else
''''''''''''''''''''''''''''''''''''''''''
'HERE WE NEED A REFERE To the next SHEET!'
''''''''''''''''''''''''''''''''''''''''''
MsgBox ("Capacity EDast")
Exit Do
End If
End Select
ElseIf StProfile(Jcounter) = 1 Then
Jcounter = Jcounter + 1
Else
MsgBox Prompt:="Wrong data entery in row " & activecell.Row & " and column" & activecell.Column, Buttons:=vbCritical
Exit Do
End
End If
Loop
