Autosorting and working out medalists for data.

[Steve Hill]

One way (change the ranges to suit your data):
=SUM(A1:A6)+SUMPRODUCT((A1:A6="X")*10)

Thanks guys, you were both very helpful and both ways did what i
wanted, (opted for Pauls though as it was easier with the amount of
data i had as it just added what was already there with the X's).

Another query on a less important note, I was thinking about adding
some functionality into the workbook that allowed for auto calculation
of medals. At the moment each archer is assigned an id number and when
it comes to working out medals, we just use data > sort for the
scores. The team medals are more difficult as we have to filter out
each university at a time and then sort the data, followed by adding
up the top four scores in the novice section and the experienced
section for each university.

Would there be some way, (I assume with macros), ,so that i could have
a seperate sheet which takes the data from the master list, containing
names, gender, scores, X's, university and experience level and
autosort them into the top three, including names and scores for each
of the below categories:

Gents Compound
Ladies Compound
Gents Experienced
Ladies Experienced
Gents Novice
Ladies Novice
Experienced Team, (top four from each university in Gents & Ladies
Experienced only, not compound)
Novice Team, (as experinced team, but for novice, obviously).

The program in its current form can be found at:
http://su.nottingham.ac.uk/archery/html/BUTTS Nottm. 03.exe

Thanks.

 

[Rocky McKinley]

I know there is an easier way but I already had the functions "Return Word"
& "Count Words" made from before. Anyway this works with no problem, you'll
have to adapt it to your specific use of course.

Sub SumString()
Dim WordNum As Integer, Result As Long, x As Byte, MyString As String
MyString = "X, 10, 9, 10, 10, 8 "
'Remove commas
For x = 1 To Len(MyString)
If Mid(MyString, x, 1) <> "," Then
Ans = Ans & Mid(MyString, x, 1)
End If
Next x
'Sum Each Word
For WordNum = 1 To CountWords(Ans)
If ReturnWord(Ans, WordNum) = "X" Then
Result = Result + 10
Else
Result = Result + ReturnWord(Ans, WordNum)
End If
Next WordNum
MsgBox Result
End Sub

'COUNTS THE WORDS IN A TEXT STRING
Function CountWords(MainString As Variant)
Dim LastChr As String, Cnt As Integer, I As Integer
MainString = " " & Trim(MainString): LastChr = "": Cnt = 0

For I = 1 To Len(MainString)
If Mid(MainString, I, 1) = " " And LastChr <> " " Then
Cnt = Cnt + 1
End If
LastChr = Mid(MainString, I, 1)
Next I

On Error GoTo ErrorHandler:

CountWords = Cnt

Exit Function
ErrorHandler:
CountWords = 0
End Function

'RETURNS THE WORDNUMBER YOU CHOOSE EG: 3 RETURNS THE 3RD WORD ETC
Function ReturnWord(MainString As Variant, WordNumber As Integer)
Dim LastChr As String, StartChrReturn As Integer, EndChrReturn As Integer,
Cnt As Integer, _
I As Integer, LeftWord As String, RightWord As String
MainString = " " & Trim(MainString) & " ": LastChr = "": Cnt = 0

For I = 1 To Len(MainString)
If Mid(MainString, I, 1) = " " And LastChr <> " " Then
Cnt = Cnt + 1
If Cnt = WordNumber Then StartChrReturn = I
If Cnt = WordNumber + 1 Then EndChrReturn = I
End If
LastChr = Mid(MainString, I, 1)
Next I
On Error GoTo ErrorHandler:
ReturnWord = Trim(Mid(MainString, StartChrReturn, EndChrReturn -
StartChrReturn))
Exit Function
ErrorHandler:
ReturnWord = ""
End Function

 

[Steve Hill]

Thanks a lot, but unfortunately I am a complete novice. I just copied
and pasted this into a blank worksheet in the book, and it came up
with two errors, on lines :

Integer
and

How do I remove these errors? If you have any advice on how to use
this or any other script that may be helpful. I would also appriciate
it.