T
The Hawk
A while back I asked how to resolve a calculation error in a Golf League
Management program and was provided with code that seemed to resolve the
problem; however, after using it for a few weeks another problem has arisen.
From the previous thread:
"The premise is basic as it uses the best 4 of the last 8 valid scores. If
only 4 scores are available it uses those. The Scores worksheet is managed by
Date/Week and the VBA code pulls the scores, ignores any zeros(0) and TEXT
(we use initials when for subs) sorts the scores in ascending order, takes
the lowest 4 and divides by 4 to get the average."
The key issue seems to be the TEXT entries and when present cause a #VALUE
error to be returned. Following is an example of row values where the error
is returned:
34 0 35 38 34 gb 39 38
Here is the code used:
Sub CalcAvg_HDCP1()
Dim gameCountFoCalc As Long
Dim rng As Range, rng1 As Range
Dim rng2 As Range, colStart As Long
Dim colEnd As Long, s As String
Dim cell As Range, s1 As String
Dim s2 As String
' Set number of game to use in calc and redefine array (Total -1)
gameCountFoCalc = 27 'for 27 weeks
Worksheets("Reg_Scores").Activate
' Locate the last column, based on the cell containing (HDCP) in row 2
Set rng = Rows(2).Find(What:="HDCP", After:=Range("A2"), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
Set rng = rng.Offset(0, -1)
Else
MsgBox "HDCP not found"
Exit Sub
End If
' Locate the last row based on the
' cell containing (<End Players>) in column 2
Set rng1 = Columns(2).Find(What:="End Players", _
After:=Range("B2"), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If rng1 Is Nothing Then
MsgBox "End Players not found"
Exit Sub
Else
Set rng1 = rng1.Offset(-1, 0)
End If
' Clear HDCP column prior to new calculations
Set rng2 = rng.Offset(1, 1).Resize(rng1.Row - 2)
rng2.ClearContents
' Loop thru a row/column and get the last numbers for calc an avg.
colStart = (rng2.Column - 1) - gameCountFoCalc
colEnd = rng2.Column - 2
s = "RC" & colStart & ":RC" & colEnd
s1 = "=IF(COUNT(IF(XX>0,XX))>=8,AVERAGE(SMALL" & _
"(IF(IF(COLUMN(XX)>=LARGE(IF(XX>0,COLUMN(XX)),8),1,0)" & _
"*IF(XX>0,XX)>0,XX),{1,2,3,4})),AVERAGE(SMALL" & _
"(IF(XX>0,XX),{1,2,3,4})))"
s2 = Application.Substitute(s1, "XX", s)
For Each cell In rng2.Offset(0, -1)
cell.FormulaArray = s2
Next
rng2.FormulaR1C1 = "=(RC[-1]-31)*.8"
End Sub
After receiving the #VALUE error determined that it is due to the TEXT
entries. Is there any way to bypass the text in the code? If not, I'd
appreciate any advice on a different code to resolve this problem.
Thanks...
Management program and was provided with code that seemed to resolve the
problem; however, after using it for a few weeks another problem has arisen.
From the previous thread:
"The premise is basic as it uses the best 4 of the last 8 valid scores. If
only 4 scores are available it uses those. The Scores worksheet is managed by
Date/Week and the VBA code pulls the scores, ignores any zeros(0) and TEXT
(we use initials when for subs) sorts the scores in ascending order, takes
the lowest 4 and divides by 4 to get the average."
The key issue seems to be the TEXT entries and when present cause a #VALUE
error to be returned. Following is an example of row values where the error
is returned:
34 0 35 38 34 gb 39 38
Here is the code used:
Sub CalcAvg_HDCP1()
Dim gameCountFoCalc As Long
Dim rng As Range, rng1 As Range
Dim rng2 As Range, colStart As Long
Dim colEnd As Long, s As String
Dim cell As Range, s1 As String
Dim s2 As String
' Set number of game to use in calc and redefine array (Total -1)
gameCountFoCalc = 27 'for 27 weeks
Worksheets("Reg_Scores").Activate
' Locate the last column, based on the cell containing (HDCP) in row 2
Set rng = Rows(2).Find(What:="HDCP", After:=Range("A2"), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
Set rng = rng.Offset(0, -1)
Else
MsgBox "HDCP not found"
Exit Sub
End If
' Locate the last row based on the
' cell containing (<End Players>) in column 2
Set rng1 = Columns(2).Find(What:="End Players", _
After:=Range("B2"), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If rng1 Is Nothing Then
MsgBox "End Players not found"
Exit Sub
Else
Set rng1 = rng1.Offset(-1, 0)
End If
' Clear HDCP column prior to new calculations
Set rng2 = rng.Offset(1, 1).Resize(rng1.Row - 2)
rng2.ClearContents
' Loop thru a row/column and get the last numbers for calc an avg.
colStart = (rng2.Column - 1) - gameCountFoCalc
colEnd = rng2.Column - 2
s = "RC" & colStart & ":RC" & colEnd
s1 = "=IF(COUNT(IF(XX>0,XX))>=8,AVERAGE(SMALL" & _
"(IF(IF(COLUMN(XX)>=LARGE(IF(XX>0,COLUMN(XX)),8),1,0)" & _
"*IF(XX>0,XX)>0,XX),{1,2,3,4})),AVERAGE(SMALL" & _
"(IF(XX>0,XX),{1,2,3,4})))"
s2 = Application.Substitute(s1, "XX", s)
For Each cell In rng2.Offset(0, -1)
cell.FormulaArray = s2
Next
rng2.FormulaR1C1 = "=(RC[-1]-31)*.8"
End Sub
After receiving the #VALUE error determined that it is due to the TEXT
entries. Is there any way to bypass the text in the code? If not, I'd
appreciate any advice on a different code to resolve this problem.
Thanks...