CALIBRATE AND RESORT R30:R629

[Greg Bonaparte]

In the following macro I would like macro to sort only if column R30:R629 has at least 24 TRUE entries. The quantitie of TRUE entries are increased by decreasing the value in V15 by decimals (ie 1.0 becomes 0.9) and vice versa for decreasing TRUE entries.

Note that once the calibration reaches a "stale mate, I'll need to guard against a software loop as the macro may never achieve exactly 24 TRUE entries, as this is just a minimum. Therefore the macro should look at AA637.  At the "stale mate" value of for example 27~30 TRUE entries, the macro will stop at the calibration showing the highest value in AA637. How can I tell the macro to use V15 to calibrate in this fashion?

Sub GreaterThan4k()
'
' GreaterThan4k Macro
'
Range("R2").Select
Selection.Copy
Range("S2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.EnableEvents = False

Range("R2,T2:T27,U2:U11,V2:W5,U30:U629").Select
Range("U30").Activate
Application.CutCopyMode = False
Selection.ClearContents

Application.EnableEvents = True

Range("B30:BA629").Select
Range("BA629").Activate
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.CLEAR
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
"R30:R629"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("B30:BA629")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
Range("S2").Select
Selection.Copy
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R2").Select
Application.CutCopyMode = False
Selection.Copy
Range("T2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Q10").Select
Application.CutCopyMode = False
Selection.Copy
Range("T3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AT30:AT37").Select
Range("AT37").Activate
Application.CutCopyMode = False
Selection.Copy
Range("T4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Q19").Select
Application.CutCopyMode = False
Selection.Copy
Range("U2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P10").Select
Application.CutCopyMode = False
Selection.Copy
Range("U3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U2").Select
Application.CutCopyMode = False
Selection.Copy
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AS30:AS31").Select
Range("AS31").Activate
Application.CutCopyMode = False
Selection.Copy
Range("U4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P19").Select
Application.CutCopyMode = False
Selection.Copy
Range("V2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P10").Select
Application.CutCopyMode = False
Selection.Copy
Range("V3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("V2").Select
Application.CutCopyMode = False
Selection.Copy
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AS30:AS31").Select
Range("AS31").Activate
Application.CutCopyMode = False
Selection.Copy
Range("V4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R2").Select
MsgBox "There may be SUGGESTED SHARES to utilize unallocated funds. Add ADDITIONAL SHARES now."

End Sub

[#2]

@Greg Bonaparte 

You might consider using the Data...What-If Analysis...Goal Seek menu item to adjust the value of cell V15 to get 24 TRUE entries. Goal Seek will require that you have a cell with a formula that counts the TRUE entries.

If V15 must be adjusted in increments of 0.1, GoalSeek can't handle that. So you may end up needing human judgement to decide which value to choose if GoalSeek gives you an "in-between" result.

I rewrote your macro to eliminate the fluff put in it by the macro recorder. the code should run faster as a result.

Sub GreaterThan4k()
'
' GreaterThan4k Macro
'
Range("S2").Value = Range("R2").Value

Application.EnableEvents = False
Range("R2,T2:T27,U2:U11,V2:W5,U30:U629").ClearContents
Application.EnableEvents = True

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 _
    Key:=Range("R30:R629"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("B30:BA629")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
'
Range("R2").Value = Range("S2").Value
Range("T2").Value = Range("R2").Value
Range("T3").Value = Range("Q10").Value

Range("AT30:AT37").Copy
Range("T4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Range("U2").Value = Range("Q19").Value
Range("U3").Value = Range("P10").Value
Range("R2").Value = Range("U2").Value

Range("AS30:AS31").Copy
Range("U4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Range("V2").Value = Range("P19").Value
Range("V3").Value = Range("P10").Value
Range("R2").Value = Range("V2").Value

Range("AS30:AS31").Copy
Range("V4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Range("R2").Select
MsgBox "There may be SUGGESTED SHARES to utilize unallocated funds. Add ADDITIONAL SHARES now."

End Sub

[#3]

Thank you, I will try your suggestion and test the non fluff code. @Brad_Yundt