I've put this code into the empty Module4:
Sub getformulae()
' requires a Formulae worksheet to exist
' used to store the initial formulae to examine
Dim cell As Range
Dim i As Long
With Sheets("Corre SS")
For Each cell In .Range("H7:H35")
If cell.HasFormula Then
i = i + 1
Sheets("Formulae").Range("A" & i) = cell.Address
Sheets("Formulae").Range("B" & i) = .Cells(cell.Row, 2)
Sheets("Formulae").Range("C" & i) = " " & cell.Formula
End If
Next 'cell
End With
End Sub
Sub changeformulae()
' used to replace the formulae using the QPct Named range
' QPct is a Fixed Named Range and, in this example, exists on the Formulae sheet for convenience
' original formulae
Range("H7,H9,H11,H13,H15,H17,H19,H23,H25,H27,H29,H31").Formula = _
"=IFERROR(IF(H8="""",""INCOMPLETE"",SUM(COUNTIF(H8,""Yes"")*INDEX(QPct,B8)/(1-COUNTIF(H8,""N/A"")))),INDEX(QPct,B8))"
' note this is a No test, rather than a Yes test
Range("H21").Formula = _
"=IFERROR(IF(H22="""",""INCOMPLETE"",SUM(COUNTIF(H22,""No"")*INDEX(QPct,B22)/(1-COUNTIF(H22,""N/A"")))),INDEX(QPct,B22))"
End Sub
Sub changeformulae2()
' used to replace the formulae using the QPct Named range
' QPct is a Fixed Named Range and, in this example, exists on the Formulae sheet for convenience
' alternative formulae
Range("H7,H9,H11,H13,H15,H17,H19,H23,H25,H27,H29,H31").Formula = _
"=IF(H8="""",""INCOMPLETE"",IF(H8=""Yes"",INDEX(QPct,B8),IF(H8=""N/A"",INDEX(QPct,B8),0)))"
' note this is a No test, rather than a Yes test
Range("H21").Formula = _
"=IF(H22="""",""INCOMPLETE"",IF(H22=""No"",INDEX(QPct,B22),IF(H22=""N/A"",INDEX(QPct,B22),0)))"
End Sub
I've also shortened the code in Module 6 to this:
Sub Clearing_Correspondence()
results = MsgBox("Are you sure you want to clear the contents of this call score?", vbYesNo, "")
If results = vbYes Then
Range("E2:E4,G2:G4,H8,H10,H12,H14,H16,H18,H20,H22,H24,H26,H28,H30,H32,E37:H37").ClearContents
Save = MsgBox("Do you wish to save the file now?", vbYesNo, "")
If Save = vbYes Then
ActiveWorkbook.Save
End If
End If
End Sub
I have set up a Static Named Range containing the percentages on the Formulae sheet. This allows me to use this formula in the majority of the cells:
H7:
Formula:
=IF(H8="","INCOMPLETE",IF(H8="Yes",INDEX(QPct,B8),IF(H8="N/A",INDEX(QPct,B8),0)))
but note that one formula is different, hence the code above.
Separating the percentages out means you can more easily adjust the percentages applied to each of the questions ... and the formulae are consistent.
Anyway, see the updated sample. Unless I am much mistaken, the alternative formulae produce the same results as the shortened replacements for the original formulae. It's easy to swap between the two using the subroutines listed above.
Regards, TMS
Bookmarks