Can't get cells to calculate

[Peter Kinross]

I have cells in Col N that get their value from a Function:
=Score(ROW(), M6, Mnth1, Mnth3, Mnth6, Year1, Year3, Year5, MStar).
I have a macro (Sort()) on a button to sort the spreadsheet, but don’t want the cells in col N to calculate during the sort, so I use a global variable FromSort set to True in the Sort() sub and set to False at the end of it.
If FromSort is True we exit from the function Score() at the beginning.
I can’t get the cells in col N to recalculate again after the sort. I have this code directly after FromSort is set to False:

Code: Select all

FromSort = False
Range("N6").Calculate
ActiveSheet.Calculate
Worksheets("CompareFundsAndModels-Super").Calculate

Yet the cells in col N do not recalc.

[HansV]

It's hard to know what is going on without seeing the workbook...

[Peter Kinross]

Code: Select all

Option Explicit

'Set importance factors for various return periods and Morningstar
Public FromSort As Boolean
Const iMnth1 As Single = 0, iMnth3 As Single = 0.5, iMnth6 As Single = 1, iMstr As Single = 3
Const iYear1 As Single = 0.9, iYear3 As Single = 0.8, iYear5 As Single = 0.7
Const AllowedAvDif As Single = 2.2 '= portion of Av that Rtn can differ before we normalize
Const DiffAdjust As Single = 4.4 '= portion of AvRtn that we change Rtn to normalize it
Const hlRtn As Single = 10 '=hard limit, Rtn - Av has to be more than this before we normalize
Const NonRows As Long = 5  'Number of non data rows above 1st row of data.
Dim M1 As Single, M3 As Single, M6 As Single, Y1 As Single, Y3 As Single, Y5 As Single, MS As Single
Dim Rw As Long

Public Function Score(Rwo As Long, Av As Single, rMnth1 As Range, rMnth3 As Range, rMnth6 As Range, _
                    rYear1 As Range, rYear3 As Range, rYear5 As Range, MStr As Range)
Dim AvRtn As Single
Dim nM1 As Single, nM3 As Single, nM6 As Single, nY3 As Single, nY1 As Single, nY5 As Single
Dim Pre As Integer
If FromSort = True Then
    Exit Function
End If
On Error GoTo Err_Score
Let Rw = Rwo  'A variable outside functions to take this value given to the function so that it could also be used in other functions
'Note have to add the number of heading rows to the rreferences below (Rw,1) becomes (Rw-5,1)
Let M1 = rMnth1.Value()(Rw - NonRows, 1)
Let M3 = rMnth3.Value()(Rw - NonRows, 1): Let M6 = rMnth6.Value()(Rw - NonRows, 1)
Let Y1 = rYear1.Value()(Rw - NonRows, 1): Let Y3 = rYear3.Value()(Rw - NonRows, 1)
Let Y5 = rYear5.Value()(Rw - NonRows, 1): Let MS = MStr.Value()(Rw - NonRows, 1)
'Do we have all Rtns <> 0? If not, set Score = 0
Pre = AreAllThere()
If Pre = 5 Then  'IE Y5 is zero and all others are there.
                 'If any others are negative set Score to 0.
    If M1 < 0 Or M3 < 0 Or M6 < 0 Or Y1 < 0 Or Y3 < 0 Then
        Score = 0: Exit Function
    Else         'IE none are negative, but Y5 is 0. Set Y5 to 0.65 of ave of M6, Y1 & Y3
        Y5 = 0.65 * (M6 + Y1 + Y3) / 3
    End If
ElseIf Pre = 0 Then
    Score = 0: Exit Function
End If
nM1 = Norm(M1, Av)
nM3 = Norm(M3, Av)
nM6 = Norm(M6, Av)
nY1 = Norm(Y1, Av)
nY3 = Norm(Y3, Av)
nY5 = Norm(Y5, Av)
Score = nM1 * iMnth1 + nM3 * iMnth3 + nM6 * iMnth6 + nY1 * iYear1 + nY3 * iYear3 + nY5 * iYear5 + MS * iMstr
Exit_Score:
Exit Function

Err_Score:
MsgBox Err.Description
GoTo Exit_Score
Resume Next
End Function

Function AreAllThere() As Integer
'If all are there except Y5 set AreAllThere to 5 otherwise to 1
'If any of M3, M6, Y1 or Y3 are 0 then set AreAllThere to 0
If M1 = 0 Or M3 = 0 Or M6 = 0 Or Y1 = 0 Or Y3 = 0 Then
    AreAllThere = 0
ElseIf Y5 = 0 Then
    AreAllThere = 5
Else
    AreAllThere = 1
End If
End Function

Function Norm(Rtn, AvRtn)
'Normalizes +ve return if too far away from average
'However, if average is -ve or Rtn < 10 then don't normalize
Dim F As Single, Diff As Single, DiffRate As Single
If Rtn >= 0 And AvRtn >= 0 And Rtn > AvRtn And Rtn > hlRtn Then
    Diff = Rtn - AvRtn
    DiffRate = Diff / AvRtn
    Select Case DiffRate
    'Only normalize if Diff/AvRtn > 1.7, IE diff is more than 70% above AvRtn
        Case Is < 0.8
            Norm = Rtn
        Case 0.7 To 1.2
            Norm = Rtn - (Diff * 0.25)
        Case 1.2 To 1.8
            Norm = Rtn - (Diff * 0.4)
        Case 1.8 To 2.7
            Norm = Rtn - (Diff * 0.45)
        Case 2.7 To 4
            Norm = Rtn - (Diff * 0.55)
        Case Else
            Norm = Rtn - (Diff * 0.65)
    End Select
Else
    Norm = Rtn
End If
End Function

Sub SortDb()
' Keyboard Shortcut: Ctrl+t
On Error GoTo Err_SortDb
'set FromSort to True so that Function (Score)won't get errors
FromSort = True
With Worksheets("CompareFunds")
    .Range("Db").Sort _
        Key1:=.Range("PercentSelctd"), Order1:=xlDescending, _
        Key2:=.Range("Calc_Score"), Order2:=xlDescending, _
        Header:=xlYes
End With
Exit_SortDb:
FromSort = False
Range("N6").Calculate
'Debug.Print FromSort
ActiveSheet.Calculate
Worksheets("CompareFunds").Calculate
Exit Sub

Err_SortDb:
FromSort = False
MsgBox Err.Description
GoTo Exit_SortDb
Resume
End Sub

[HansV]

See my previous reply...

[Peter Kinross]

Yep, sorry about that Hans. Definitely a bit (lot) rude of me.
At the moment I am still working even though our city, Melbourne, is about to knock London of the perch for the worldwide record number of lockdown days. And our lockdowns are quite a bit more severe. Makes life hard and time in very short supply.
On top of that our dear federal government has mandated that Financial Advisers must obtain a uni degree. No allowance whatsoever for any existing superb qualifications nor for over 3 decades of perfect practice. Nope, sit it, pass it (by 1/1/24) or get out of the profession. Even worse they have mandated that we sit and pass a final exam before we even get to the degree. I doubt if any country has ever mandated that folk have to pass a final exam (definitely not a qualifying one, as all the subject matter is dealt with within the degree course) before sitting the degree course. So, I am frantically studying for this compulsory exam. I am a fully qualified structural engineer, a fully qualified Financial Planner, so I perhaps should know a bit about passing exams, yet with this one I have failed it twice to date. So not easy by any means - well not for me.
Thus when I say that time is in short supply, I'm not joking.
The government's reason, is that this is to increase the quality of Australia's advisers as they are a bit suspect. Yeah right! In the last 30 years there have been precisely 203 financial advisers sanctioned by the authorities in all of Australia. No other country could boast figures even remotely as good.
Hope this doesn't contravene any Lounge rules. Probably comes close, but all I have done is state facts - well almost all.
I did a workaround on the above problem. Sorry to trouble you.

[HansV]

I hope you'll pass the next time!

[Peter Kinross]

Actually, this was not the one that I did a workaround for. Still stymied on this one.
Problem is, is that this is a bit confidential. I can't really post the workbook here.
I'll try to obfuscate it.

[Peter Kinross]

Here it is in it's most basic form.
When I press the Sort Db button, the Calc Scores won't calculate. They will calculate if I subsequently alter a data cell, but not the way one would want it to work. I use that Sort Db button a lot.
This was working, danged if I can recall doing anything to change it, but it sure won't work now.

[HansV]

Thanks, I see the problem happening now.
I'll be busy with other things for a while, but I'll try to investigate it and see if I can find a cause and/or solution.

[HansV]

This appears to work:

Code: Select all

Application.CalculateFull

[Peter Kinross]

Well I'll be...
Don't know why I'm amazed, you are after all, the one and only Hans.
What a simple solution. I have spent a fair bit of time I currently don't have on this.
As we say in Aus., Hans you bloody ripper! (That is a term of endearment, not of tearing apart)

ThanksHansStamp.gif