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...
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...