Is there away have empty cells to only appear after populated cells after of the Descending "R" sort?
Sub GreaterThan4k()
Range("S2").Value = Range("R2").Value
Application.EnableEvents = False
Range("R2,T2:T27,U2:U11,V2:V5,U41:U3880").ClearContents
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayStatusBar = True
.EnableEvents = False
End With
Range("B41:BF81").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.CLEAR
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 _
Key:=Range("R41:R81"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("B41:BF81")
.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("AT41:AT48").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("AS41:AS42").Copy
Range("U4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("R2").Select
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.EnableEvents = True
End With
Range("BG14").Select
Selection.Copy
Range("BI11").Select
ActiveSheet.Paste
a = MsgBox("TRADING INSTRUMENTS MUST DEMONSTRATE" & _
vbCrLf + "LOGARITHMICALLY NEGATIVE PEACHFUZZ VALUE." & _
vbCrLf + "" & _
vbCrLf + "1&3 MINUTE FREESTOCKCHARTS.COM STATUS MUST GENERATE" & _
vbCrLf + "DOWNWARD BOUND PRICE, LESS THAN VWAP." & _
vbCrLf + "" & _
vbCrLf + "DO YOU WANT TO EDIT HonorSystem24 RESULTS, TO CONFIRM" & _
vbCrLf + "NEGATIVE PEACHFUZZ, AND FREESTOCKCHARTS.COM STATUS?", vbQuestion + vbYesNo, "HonorSystem24")
If a = vbYes Then
Call BFClear
ElseIf a = vbNo Then
MsgBox "YOU MAY HAVE UNALLOCATED FUNDS REMAINING. SEE 'SUGGESTED' TO ADD ADDITIONAL SHARES"
End If
End Sub
