VBA Calculation Error

T

The Hawk

I created a Golf League Manager program in Excel and been using it for
several years. Not being particularly good at programming I needed help with
the handicap portion. After working well all of a sudden this year it started
giving some erroneous values. 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. Most times it works flawlessly; however, in some cases it returns
an erroneous result. For example, for one string of scores:
0 0 0 49 46 57 0 52
It returns an average of 35.5 and a Hdcp of 4 when it should be 51 and 16.

The Code steps through each row by Player. The person that helped me is no
longer available so any help will be appreciated to resolve or simplify. The
code is as follows:

Sub CalcAvg()
' Dim colLimit As Integer, rowLimit As Integer, holdNbrs(5) As Integer
' Dim colIndex As Integer, rowIndex As Integer, holdIndex As Integer
' Dim totNbr As Integer, i As Integer, j As Integer, testData As Variant
' Dim firstEle As Integer, lastEle As Integer, temp As Integer
' Dim gameCountFoCalc As Integer

' Set number of game to use in calc and redefine array (Total -1)
gameCountFoCalc = 7 'for 8 weeks
ReDim holdNbrs(gameCountFoCalc)

Worksheets("Reg_Scores").Activate

' Locate the last column, based on the cell containing (HDCP) in row 2
rowIndex = 2
colIndex = 2
Do Until colIndex >= 100
colIndex = colIndex + 1
If Cells(rowIndex, colIndex).Value = "HDCP" Then
colLimit = colIndex
colIndex = 100
End If
Loop

' Locate the last row based on the cell containing (<End Players>) in
column 2
rowIndex = 3
colIndex = 2
Do Until rowIndex >= 500
rowIndex = rowIndex + 1
If Cells(rowIndex, colIndex) = "<End Players>" Then
rowLimit = rowIndex
rowIndex = 500
End If
Loop

' Clear HDCP column prior to new calculations
rowIndex = 3
colIndex = (colLimit - 1)
Do Until rowIndex >= (rowLimit - 1)
rowIndex = rowIndex + 1
Cells(rowIndex, colIndex).Value = ""
Loop

' Loop thru a row/column and get the last numbers for calc an avg.
rowIndex = 3
Do Until rowIndex >= (rowLimit - 1)
holdIndex = 0
Do Until holdIndex = gameCountFoCalc
holdNbrs(holdIndex) = 0
holdIndex = holdIndex + 1
Loop
holdIndex = 0
colIndex = (colLimit - 1)
Do Until (colIndex < 4) Or (holdIndex > gameCountFoCalc)
colIndex = colIndex - 1
testData = Cells(rowIndex, colIndex).Value
If IsNumeric(testData) Then
If Cells(rowIndex, colIndex).Value > 0 Then
holdNbrs(holdIndex) = Cells(rowIndex, colIndex).Value
holdIndex = holdIndex + 1
End If
End If
Loop
totNbr = 0

If (holdIndex - 1) > 2 Then
firstEle = LBound(holdNbrs)
lastEle = UBound(holdNbrs)
For i = firstEle To lastEle - 1
For j = i + 1 To lastEle
If holdNbrs(i) > holdNbrs(j) Then
temp = holdNbrs(j)
holdNbrs(j) = holdNbrs(i)
holdNbrs(i) = temp
End If
Next j
Next i
If holdNbrs(0) > 0 Then
totNbr = holdNbrs(0) + holdNbrs(1) + holdNbrs(2) + holdNbrs(3)
ElseIf holdNbrs(1) > 0 Then
totNbr = holdNbrs(1) + holdNbrs(2) + holdNbrs(3) + holdNbrs(4)
Else
totNbr = holdNbrs(2) + holdNbrs(3) + holdNbrs(4) + holdNbrs(5)
End If
End If
If totNbr > 0 Then
Cells(rowIndex, (colLimit - 1)).Value = totNbr / 4
Else
Cells(rowIndex, (colLimit - 1)).Value = ""
End If
rowIndex = rowIndex + 1
Loop

End Sub

Thanks...
 
M

martin

Would be easier to help you if you gave more details on the layout of
the spreadsheet. What is there besides golf scores? I got that "<End
Players>" appears in column B of the row after the last row of scores
and that "HDCP" appears in row 2 of the column after the column
containing the last score. Also (I don't play much golf) how is
handicap calculated? 67 minus average?
 
T

The Hawk

Here's a sample of the sheet:

TM PLAYER 0 1 20 AVG HDCP
1 Player 1 0 39 34.8 3
1 Player 2 0 gb (25)
1 Player 3 0 38 (25)
1 Player 4 0 37 (25)
2 Player 1 0 36 (25)
2 Player 2 0 35 (25)
2 Player 3 0 43 (25)
2 Player 4 0 lr (25)
3 Player 1 0 ks (25)

<End Players>

First column is TEAM. I use this for sorts along with the AVG to determine
playing position (i.e., 1, 2, 3, 4) for each week. Columns 0, 1 ... 20
indicate weeks. There are 6 columns before Week 0 which are the last 6 scores
from the prior year. HDCP is calculated based on a formula (=<AVG>-31*.8).
Our league plays on a par 62 (31 for 9) Executive Course.

Thanks...
 
T

Tom Ogilvy

Make sure you set gameCountFoCalc to the number of games to be considered in
the average.

If there are fewer than 4 scores in that range of columns from the average
column then it will display #Num


Sub CalcAvg_HDCP()
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

' Set number of game to use in calc and redefine array (Total -1)
gameCountFoCalc = 7 'for 8 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
For Each cell In rng2.Offset(0, -1)
cell.FormulaArray = "=AVERAGE(SMALL(IF(" & s & ">0," & _
s & "),{1,2,3,4}))"
Next
rng2.FormulaR1C1 = "=(RC[-1]-31)*.8"
End Sub
 
T

Tom Ogilvy

I didn't change this comment:

gameCountFoCalc = 7 'for 8 weeks

but in my implementation, for 8 weeks, you would set it to 8

gameCountFoCalc = 8 'for 8 weeks

The latest number of weeks you want to consider.

--
Regards,
Tom Ogilvy


Tom Ogilvy said:
Make sure you set gameCountFoCalc to the number of games to be considered in
the average.

If there are fewer than 4 scores in that range of columns from the average
column then it will display #Num


Sub CalcAvg_HDCP()
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

' Set number of game to use in calc and redefine array (Total -1)
gameCountFoCalc = 7 'for 8 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
For Each cell In rng2.Offset(0, -1)
cell.FormulaArray = "=AVERAGE(SMALL(IF(" & s & ">0," & _
s & "),{1,2,3,4}))"
Next
rng2.FormulaR1C1 = "=(RC[-1]-31)*.8"
End Sub

--
Regards,
Tom Ogilvy


The Hawk said:
Here's a sample of the sheet:

TM PLAYER 0 1 20 AVG HDCP
1 Player 1 0 39 34.8 3
1 Player 2 0 gb (25)
1 Player 3 0 38 (25)
1 Player 4 0 37 (25)
2 Player 1 0 36 (25)
2 Player 2 0 35 (25)
2 Player 3 0 43 (25)
2 Player 4 0 lr (25)
3 Player 1 0 ks (25)

<End Players>

First column is TEAM. I use this for sorts along with the AVG to determine
playing position (i.e., 1, 2, 3, 4) for each week. Columns 0, 1 ... 20
indicate weeks. There are 6 columns before Week 0 which are the last 6 scores
from the prior year. HDCP is calculated based on a formula
(= said:
Our league plays on a par 62 (31 for 9) Executive Course.

Thanks...
 
T

The Hawk

Thanks Tom. I loaded the code and when trying to run received #NUM in every
cell in the AVG column. Checked the Reg_Scores Worksheet AVG column and
found that the Array loaded was:

{=AVERAGE(SMALL(IF($V5:$AC5>0,$V5:$AC5),{1,2,3,4}))}

As there was no data in $V5:$AC5 changed it in one of the cells to $C5:$AC5
which captured all scores entered and everything worked. It seems the code
set just the last 8 columns before HDCP; however, I'm not sure what to do
with it to ensure it picks the last 8 cells with valid scores (>0).

Thanks...


Tom Ogilvy said:
I didn't change this comment:

gameCountFoCalc = 7 'for 8 weeks

but in my implementation, for 8 weeks, you would set it to 8

gameCountFoCalc = 8 'for 8 weeks

The latest number of weeks you want to consider.

--
Regards,
Tom Ogilvy


Tom Ogilvy said:
Make sure you set gameCountFoCalc to the number of games to be considered in
the average.

If there are fewer than 4 scores in that range of columns from the average
column then it will display #Num


Sub CalcAvg_HDCP()
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

' Set number of game to use in calc and redefine array (Total -1)
gameCountFoCalc = 7 'for 8 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
For Each cell In rng2.Offset(0, -1)
cell.FormulaArray = "=AVERAGE(SMALL(IF(" & s & ">0," & _
s & "),{1,2,3,4}))"
Next
rng2.FormulaR1C1 = "=(RC[-1]-31)*.8"
End Sub

--
Regards,
Tom Ogilvy


The Hawk said:
Here's a sample of the sheet:

TM PLAYER 0 1 20 AVG HDCP
1 Player 1 0 39 34.8 3
1 Player 2 0 gb (25)
1 Player 3 0 38 (25)
1 Player 4 0 37 (25)
2 Player 1 0 36 (25)
2 Player 2 0 35 (25)
2 Player 3 0 43 (25)
2 Player 4 0 lr (25)
3 Player 1 0 ks (25)

<End Players>

First column is TEAM. I use this for sorts along with the AVG to determine
playing position (i.e., 1, 2, 3, 4) for each week. Columns 0, 1 ... 20
indicate weeks. There are 6 columns before Week 0 which are the last 6 scores
from the prior year. HDCP is calculated based on a formula
(= said:
Our league plays on a par 62 (31 for 9) Executive Course.

Thanks...

:

Would be easier to help you if you gave more details on the layout of
the spreadsheet. What is there besides golf scores? I got that "<End
Players>" appears in column B of the row after the last row of scores
and that "HDCP" appears in row 2 of the column after the column
containing the last score. Also (I don't play much golf) how is
handicap calculated? 67 minus average?
 
T

Tom Ogilvy

Change

gameCountFoCalc = 8 'for 8 weeks

to

gameCountFoCalc = 27 'for 27 weeks

--
Regards,
Tom Ogilvy


The Hawk said:
Thanks Tom. I loaded the code and when trying to run received #NUM in every
cell in the AVG column. Checked the Reg_Scores Worksheet AVG column and
found that the Array loaded was:

{=AVERAGE(SMALL(IF($V5:$AC5>0,$V5:$AC5),{1,2,3,4}))}

As there was no data in $V5:$AC5 changed it in one of the cells to $C5:$AC5
which captured all scores entered and everything worked. It seems the code
set just the last 8 columns before HDCP; however, I'm not sure what to do
with it to ensure it picks the last 8 cells with valid scores (>0).

Thanks...


Tom Ogilvy said:
I didn't change this comment:

gameCountFoCalc = 7 'for 8 weeks

but in my implementation, for 8 weeks, you would set it to 8

gameCountFoCalc = 8 'for 8 weeks

The latest number of weeks you want to consider.

--
Regards,
Tom Ogilvy


Tom Ogilvy said:
Make sure you set gameCountFoCalc to the number of games to be
considered
in
the average.

If there are fewer than 4 scores in that range of columns from the average
column then it will display #Num


Sub CalcAvg_HDCP()
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

' Set number of game to use in calc and redefine array (Total -1)
gameCountFoCalc = 7 'for 8 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
For Each cell In rng2.Offset(0, -1)
cell.FormulaArray = "=AVERAGE(SMALL(IF(" & s & ">0," & _
s & "),{1,2,3,4}))"
Next
rng2.FormulaR1C1 = "=(RC[-1]-31)*.8"
End Sub

--
Regards,
Tom Ogilvy


Here's a sample of the sheet:

TM PLAYER 0 1 20 AVG HDCP
1 Player 1 0 39 34.8 3
1 Player 2 0 gb (25)
1 Player 3 0 38 (25)
1 Player 4 0 37 (25)
2 Player 1 0 36 (25)
2 Player 2 0 35 (25)
2 Player 3 0 43 (25)
2 Player 4 0 lr (25)
3 Player 1 0 ks (25)

<End Players>

First column is TEAM. I use this for sorts along with the AVG to
determine
playing position (i.e., 1, 2, 3, 4) for each week. Columns 0, 1 ... 20
indicate weeks. There are 6 columns before Week 0 which are the last 6
scores
from the prior year. HDCP is calculated based on a formula
(=<AVG>-31*.8).
Our league plays on a par 62 (31 for 9) Executive Course.

Thanks...

:

Would be easier to help you if you gave more details on the layout of
the spreadsheet. What is there besides golf scores? I got that "<End
Players>" appears in column B of the row after the last row of scores
and that "HDCP" appears in row 2 of the column after the column
containing the last score. Also (I don't play much golf) how is
handicap calculated? 67 minus average?
 
T

The Hawk

That's it! Thanks Tom...

Tom Ogilvy said:
Change

gameCountFoCalc = 8 'for 8 weeks

to

gameCountFoCalc = 27 'for 27 weeks

--
Regards,
Tom Ogilvy


The Hawk said:
Thanks Tom. I loaded the code and when trying to run received #NUM in every
cell in the AVG column. Checked the Reg_Scores Worksheet AVG column and
found that the Array loaded was:

{=AVERAGE(SMALL(IF($V5:$AC5>0,$V5:$AC5),{1,2,3,4}))}

As there was no data in $V5:$AC5 changed it in one of the cells to $C5:$AC5
which captured all scores entered and everything worked. It seems the code
set just the last 8 columns before HDCP; however, I'm not sure what to do
with it to ensure it picks the last 8 cells with valid scores (>0).

Thanks...


Tom Ogilvy said:
I didn't change this comment:

gameCountFoCalc = 7 'for 8 weeks

but in my implementation, for 8 weeks, you would set it to 8

gameCountFoCalc = 8 'for 8 weeks

The latest number of weeks you want to consider.

--
Regards,
Tom Ogilvy


Make sure you set gameCountFoCalc to the number of games to be considered
in
the average.

If there are fewer than 4 scores in that range of columns from the average
column then it will display #Num


Sub CalcAvg_HDCP()
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

' Set number of game to use in calc and redefine array (Total -1)
gameCountFoCalc = 7 'for 8 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
For Each cell In rng2.Offset(0, -1)
cell.FormulaArray = "=AVERAGE(SMALL(IF(" & s & ">0," & _
s & "),{1,2,3,4}))"
Next
rng2.FormulaR1C1 = "=(RC[-1]-31)*.8"
End Sub

--
Regards,
Tom Ogilvy


Here's a sample of the sheet:

TM PLAYER 0 1 20 AVG HDCP
1 Player 1 0 39 34.8 3
1 Player 2 0 gb (25)
1 Player 3 0 38 (25)
1 Player 4 0 37 (25)
2 Player 1 0 36 (25)
2 Player 2 0 35 (25)
2 Player 3 0 43 (25)
2 Player 4 0 lr (25)
3 Player 1 0 ks (25)

<End Players>

First column is TEAM. I use this for sorts along with the AVG to
determine
playing position (i.e., 1, 2, 3, 4) for each week. Columns 0, 1 ... 20
indicate weeks. There are 6 columns before Week 0 which are the last 6
scores
from the prior year. HDCP is calculated based on a formula
(=<AVG>-31*.8).
Our league plays on a par 62 (31 for 9) Executive Course.

Thanks...

:

Would be easier to help you if you gave more details on the layout of
the spreadsheet. What is there besides golf scores? I got that "<End
Players>" appears in column B of the row after the last row of scores
and that "HDCP" appears in row 2 of the column after the column
containing the last score. Also (I don't play much golf) how is
handicap calculated? 67 minus average?
 
T

The Hawk

Performed some more testing and still have a flaw some where. After changing
gameCountFoCalc to 27 the averge is calculated on all values not just the
best 4 of the last 8. Do we need to add a COUNT of valid values by Row some
how?

Darn...

The Hawk said:
That's it! Thanks Tom...

Tom Ogilvy said:
Change

gameCountFoCalc = 8 'for 8 weeks

to

gameCountFoCalc = 27 'for 27 weeks

--
Regards,
Tom Ogilvy


The Hawk said:
Thanks Tom. I loaded the code and when trying to run received #NUM in every
cell in the AVG column. Checked the Reg_Scores Worksheet AVG column and
found that the Array loaded was:

{=AVERAGE(SMALL(IF($V5:$AC5>0,$V5:$AC5),{1,2,3,4}))}

As there was no data in $V5:$AC5 changed it in one of the cells to $C5:$AC5
which captured all scores entered and everything worked. It seems the code
set just the last 8 columns before HDCP; however, I'm not sure what to do
with it to ensure it picks the last 8 cells with valid scores (>0).

Thanks...


:

I didn't change this comment:

gameCountFoCalc = 7 'for 8 weeks

but in my implementation, for 8 weeks, you would set it to 8

gameCountFoCalc = 8 'for 8 weeks

The latest number of weeks you want to consider.

--
Regards,
Tom Ogilvy


Make sure you set gameCountFoCalc to the number of games to be considered
in
the average.

If there are fewer than 4 scores in that range of columns from the average
column then it will display #Num


Sub CalcAvg_HDCP()
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

' Set number of game to use in calc and redefine array (Total -1)
gameCountFoCalc = 7 'for 8 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
For Each cell In rng2.Offset(0, -1)
cell.FormulaArray = "=AVERAGE(SMALL(IF(" & s & ">0," & _
s & "),{1,2,3,4}))"
Next
rng2.FormulaR1C1 = "=(RC[-1]-31)*.8"
End Sub

--
Regards,
Tom Ogilvy


Here's a sample of the sheet:

TM PLAYER 0 1 20 AVG HDCP
1 Player 1 0 39 34.8 3
1 Player 2 0 gb (25)
1 Player 3 0 38 (25)
1 Player 4 0 37 (25)
2 Player 1 0 36 (25)
2 Player 2 0 35 (25)
2 Player 3 0 43 (25)
2 Player 4 0 lr (25)
3 Player 1 0 ks (25)

<End Players>

First column is TEAM. I use this for sorts along with the AVG to
determine
playing position (i.e., 1, 2, 3, 4) for each week. Columns 0, 1 ... 20
indicate weeks. There are 6 columns before Week 0 which are the last 6
scores
from the prior year. HDCP is calculated based on a formula
(=<AVG>-31*.8).
Our league plays on a par 62 (31 for 9) Executive Course.

Thanks...

:

Would be easier to help you if you gave more details on the layout of
the spreadsheet. What is there besides golf scores? I got that "<End
Players>" appears in column B of the row after the last row of scores
and that "HDCP" appears in row 2 of the column after the column
containing the last score. Also (I don't play much golf) how is
handicap calculated? 67 minus average?
 
T

Tom Ogilvy

Try this one:

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

--
Regards,
Tom Ogilvy


The Hawk said:
Performed some more testing and still have a flaw some where. After changing
gameCountFoCalc to 27 the averge is calculated on all values not just the
best 4 of the last 8. Do we need to add a COUNT of valid values by Row some
how?

Darn...

The Hawk said:
That's it! Thanks Tom...

Tom Ogilvy said:
Change

gameCountFoCalc = 8 'for 8 weeks

to

gameCountFoCalc = 27 'for 27 weeks

--
Regards,
Tom Ogilvy


Thanks Tom. I loaded the code and when trying to run received #NUM in
every
cell in the AVG column. Checked the Reg_Scores Worksheet AVG column and
found that the Array loaded was:

{=AVERAGE(SMALL(IF($V5:$AC5>0,$V5:$AC5),{1,2,3,4}))}

As there was no data in $V5:$AC5 changed it in one of the cells to
$C5:$AC5
which captured all scores entered and everything worked. It seems the
code
set just the last 8 columns before HDCP; however, I'm not sure what to do
with it to ensure it picks the last 8 cells with valid scores (>0).

Thanks...


:

I didn't change this comment:

gameCountFoCalc = 7 'for 8 weeks

but in my implementation, for 8 weeks, you would set it to 8

gameCountFoCalc = 8 'for 8 weeks

The latest number of weeks you want to consider.

--
Regards,
Tom Ogilvy


Make sure you set gameCountFoCalc to the number of games to be
considered
in
the average.

If there are fewer than 4 scores in that range of columns from the
average
column then it will display #Num


Sub CalcAvg_HDCP()
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

' Set number of game to use in calc and redefine array (Total -1)
gameCountFoCalc = 7 'for 8 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
For Each cell In rng2.Offset(0, -1)
cell.FormulaArray = "=AVERAGE(SMALL(IF(" & s & ">0," & _
s & "),{1,2,3,4}))"
Next
rng2.FormulaR1C1 = "=(RC[-1]-31)*.8"
End Sub

--
Regards,
Tom Ogilvy


Here's a sample of the sheet:

TM PLAYER 0 1 20 AVG HDCP
1 Player 1 0 39 34.8 3
1 Player 2 0 gb (25)
1 Player 3 0 38 (25)
1 Player 4 0 37 (25)
2 Player 1 0 36 (25)
2 Player 2 0 35 (25)
2 Player 3 0 43 (25)
2 Player 4 0 lr (25)
3 Player 1 0 ks (25)

<End Players>

First column is TEAM. I use this for sorts along with the AVG to
determine
playing position (i.e., 1, 2, 3, 4) for each week. Columns 0, 1 ...
20
indicate weeks. There are 6 columns before Week 0 which are the last
6
scores
from the prior year. HDCP is calculated based on a formula
(=<AVG>-31*.8).
Our league plays on a par 62 (31 for 9) Executive Course.

Thanks...

:

Would be easier to help you if you gave more details on the layout
of
the spreadsheet. What is there besides golf scores? I got that
"<End
Players>" appears in column B of the row after the last row of
scores
and that "HDCP" appears in row 2 of the column after the column
containing the last score. Also (I don't play much golf) how is
handicap calculated? 67 minus average?
 
T

The Hawk

Tom,
That did it!

Thanks so much...

Tom Ogilvy said:
Try this one:

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

--
Regards,
Tom Ogilvy


The Hawk said:
Performed some more testing and still have a flaw some where. After changing
gameCountFoCalc to 27 the averge is calculated on all values not just the
best 4 of the last 8. Do we need to add a COUNT of valid values by Row some
how?

Darn...

The Hawk said:
That's it! Thanks Tom...

:

Change

gameCountFoCalc = 8 'for 8 weeks

to

gameCountFoCalc = 27 'for 27 weeks

--
Regards,
Tom Ogilvy


Thanks Tom. I loaded the code and when trying to run received #NUM in
every
cell in the AVG column. Checked the Reg_Scores Worksheet AVG column and
found that the Array loaded was:

{=AVERAGE(SMALL(IF($V5:$AC5>0,$V5:$AC5),{1,2,3,4}))}

As there was no data in $V5:$AC5 changed it in one of the cells to
$C5:$AC5
which captured all scores entered and everything worked. It seems the
code
set just the last 8 columns before HDCP; however, I'm not sure what to do
with it to ensure it picks the last 8 cells with valid scores (>0).

Thanks...


:

I didn't change this comment:

gameCountFoCalc = 7 'for 8 weeks

but in my implementation, for 8 weeks, you would set it to 8

gameCountFoCalc = 8 'for 8 weeks

The latest number of weeks you want to consider.

--
Regards,
Tom Ogilvy


Make sure you set gameCountFoCalc to the number of games to be
considered
in
the average.

If there are fewer than 4 scores in that range of columns from the
average
column then it will display #Num


Sub CalcAvg_HDCP()
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

' Set number of game to use in calc and redefine array (Total -1)
gameCountFoCalc = 7 'for 8 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
For Each cell In rng2.Offset(0, -1)
cell.FormulaArray = "=AVERAGE(SMALL(IF(" & s & ">0," & _
s & "),{1,2,3,4}))"
Next
rng2.FormulaR1C1 = "=(RC[-1]-31)*.8"
End Sub

--
Regards,
Tom Ogilvy


Here's a sample of the sheet:

TM PLAYER 0 1 20 AVG HDCP
1 Player 1 0 39 34.8 3
1 Player 2 0 gb (25)
1 Player 3 0 38 (25)
1 Player 4 0 37 (25)
2 Player 1 0 36 (25)
2 Player 2 0 35 (25)
2 Player 3 0 43 (25)
2 Player 4 0 lr (25)
3 Player 1 0 ks (25)

<End Players>

First column is TEAM. I use this for sorts along with the AVG to
determine
playing position (i.e., 1, 2, 3, 4) for each week. Columns 0, 1 ...
20
indicate weeks. There are 6 columns before Week 0 which are the last
6
scores
from the prior year. HDCP is calculated based on a formula
(=<AVG>-31*.8).
Our league plays on a par 62 (31 for 9) Executive Course.

Thanks...

:

Would be easier to help you if you gave more details on the layout
of
the spreadsheet. What is there besides golf scores? I got that
"<End
Players>" appears in column B of the row after the last row of
scores
and that "HDCP" appears in row 2 of the column after the column
containing the last score. Also (I don't play much golf) how is
handicap calculated? 67 minus average?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top