Net Points System expansion of my VBA

B

Big Lar

Well-known Member
Joined
May 19, 2002
Messages
554
<o:p></o:p>
This is snipped from my VBA routine for my Golf scoring application.<o:p></o:p>
Basically,I select players from the db and enter hole-by-hole scores.<o:p></o:p>
The code enters the player’s name and scores onto the gross score sheet <o:p></o:p>
<o:p></o:p>
Rich (BB code): 
PrivateSub CommandButton1_Click()<o:p></o:p>
<o:p></o:p>
Dim iRowAs Long<o:p></o:p>
Dim ws AsWorksheet<o:p></o:p>
DimFullPlayerName As String<o:p></o:p>
Dim CLocAs Range<o:p></o:p>
<o:p></o:p>
Set ws =Worksheets("GROSS")<o:p></o:p>
<o:p></o:p>
FullPlayerName= Me.ComboBox1.Value<o:p></o:p>
    Set CLoc =ws.Columns("A:A").Find(What:=FullPlayerName, After:=ws.Cells(10, 1),LookIn:= _<o:p></o:p>
                            xlFormulas,LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _<o:p></o:p>
                            xlNext, MatchCase:=False,SearchFormat:=False)<o:p></o:p>
    If CLoc Is Nothing Then<o:p></o:p>
        iRow = ws.Cells(Rows.Count, 1) _<o:p></o:p>
               .End(xlUp).Offset(1, 0).Row<o:p></o:p>
    Else<o:p></o:p>
        iRow = CLoc.Row<o:p></o:p>
    End If<o:p></o:p>
<o:p></o:p>
'copy thedata to the GROSS Sheet<o:p></o:p>
ws.Cells(iRow,1).Value = Me.ComboBox1.Value<o:p></o:p>
ws.Cells(iRow,2).Value = Me.TextBox4.Value<o:p></o:p>
ws.Cells(iRow,3).Value = Me.TextBox5.Value<o:p></o:p>
ws.Cells(iRow,4).Value = Me.TextBox6.Value<o:p></o:p>
‘etc..etc…<o:p></o:p>
<o:p></o:p>
Sheets("GROSS").Select

Range("A10:Y50").SortKey1:=Range("Y10"), Order1:=xlAscending, _<o:p></o:p>
        MatchCase:=False,Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _<o:p></o:p>
        DataOption2:=xlSortNormal,DataOption3:=xlSortNormal<o:p></o:p>
<o:p></o:p>


The code continues, using the UserForm entries to determine where the player’s handicap strokes fall and adjusting their net scores accordingly. The application is capable of being used at any golf course, therefore, a variable, (Sheet“COURSE”) provides the par and handicap data for each different course played.

Rich (BB code): 
Set ws =Worksheets("NET")<o:p></o:p>
<o:p></o:p>
FullPlayerName= Me.ComboBox1.Value<o:p></o:p>
    Set CLoc =ws.Columns("A:A").Find(What:=FullPlayerName, After:=ws.Cells(11, 1),LookIn:= _<o:p></o:p>
                            xlFormulas,LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _<o:p></o:p>
                            xlNext,MatchCase:=False, SearchFormat:=False)<o:p></o:p>
    If CLoc Is Nothing Then<o:p></o:p>
        iRow = ws.Cells(Rows.Count, 1) _<o:p></o:p>
               .End(xlUp).Offset(1, 0).Row<o:p></o:p>
    Else<o:p></o:p>
        iRow = CLoc.Row<o:p></o:p>
    End If<o:p></o:p>
<o:p></o:p>
‘Determine player’s handicap holes<o:p></o:p>
Dim x AsDouble<o:p></o:p>
    Select Case Val(Me.TextBox3.Value)<o:p></o:p>
    Case Is <sheets("course").range("b2") +1<o:p="" b="Me.TextBox4.Value" -=""></sheets("course").range("b2")>
    Case Is <sheets("course").range("b2"): b="Me.TextBox4.Value<o:p"></sheets("course").range("b2"):>
    Case Is <sheets("course").range("b2") -1<o:p="" b="Me.TextBox4.Value" +=""></sheets("course").range("b2")>
    Case Else: b = Me.TextBox4.Value - 2<o:p></o:p>
End Select<o:p></o:p>
    <o:p></o:p>
    Select Case Val(Me.TextBox3.Value)<o:p></o:p>
    Case Is <sheets("course").range("c2") +1<o:p="" -="" c="Me.TextBox5.Value"></sheets("course").range("c2")>
    Case Is <sheets("course").range("c2"): c="Me.TextBox5.Value<o:p"></sheets("course").range("c2"):>
    Case Is <sheets("course").range("c2") -1<o:p="" +="" c="Me.TextBox5.Value"></sheets("course").range("c2")>
    Case Else: c = Me.TextBox5.Value - 2<o:p></o:p>
End Select<o:p></o:p>
‘etc…etc…<o:p></o:p>
<o:p></o:p>
‘Post Net scores to NET sheet<o:p></o:p>
ws.Cells(iRow,1).Value = Me.ComboBox1.Value<o:p></o:p>
ws.Cells(iRow,2).Value = Me.TextBox3.Value<o:p></o:p>
ws.Cells(iRow,3).Value = b<o:p></o:p>
ws.Cells(iRow,4).Value = c<o:p></o:p>
‘etc…etc…<o:p></o:p>
<o:p></o:p>
Sheets("NET").Select<o:p></o:p>
Range("A11:Y51").SortKey1:=Range("W10"), Order1:=xlAscending, Key2:=Range _<o:p></o:p>
        ("V10"), Order2:=xlAscending,Key3:=Range("X10"), Order3:=xlAscending, _<o:p></o:p>
        Header:=xlGuess, OrderCustom:=1, _<o:p></o:p>
        MatchCase:=False,Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _<o:p></o:p>
        DataOption2:=xlSortNormal,DataOption3:=xlSortNormal
<o:p></o:p>
Finally, a points scoring system is applied to the POINTS sheet<o:p></o:p>
<o:p></o:p>
Rich (BB code): 
Set ws =Worksheets("POINTS")<o:p></o:p>
<o:p></o:p>
FullPlayerName= Me.ComboBox1.Value<o:p></o:p>
    Set CLoc =ws.Columns("A:A").Find(What:=FullPlayerName, After:=ws.Cells(11, 1),LookIn:= _<o:p></o:p>
                            xlFormulas,LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _<o:p></o:p>
                            xlNext,MatchCase:=False, SearchFormat:=False)<o:p></o:p>
    If CLoc Is Nothing Then<o:p></o:p>
        iRow = ws.Cells(Rows.Count, 1) _<o:p></o:p>
               .End(xlUp).Offset(1, 0).Row<o:p></o:p>
    Else<o:p></o:p>
        iRow = CLoc.Row<o:p></o:p>
    End If<o:p></o:p>
<o:p></o:p>
    Select Case Val(Me.TextBox4.Value) '1<o:p></o:p>
    Case Is =Sheets("GROSS").Range("B8") + 1: b = -1<o:p></o:p>
    Case Is =Sheets("GROSS").Range("B8"): b = 0<o:p></o:p>
    Case Is =Sheets("GROSS").Range("B8") - 1: b = 2<o:p></o:p>
    Case Is =Sheets("GROSS").Range("B8") - 2: b = 5<o:p></o:p>
    Case Is =Sheets("GROSS").Range("B8") - 3: b = 8<o:p></o:p>
        Case Else: b = -3<o:p></o:p>
<o:p></o:p>
End Select<o:p></o:p>
<o:p></o:p>
SelectCase Val(Me.TextBox5.Value) '2<o:p></o:p>
    Case Is =Sheets("GROSS").Range("C8") + 1: c = -1<o:p></o:p>
    Case Is =Sheets("GROSS").Range("C8"): c = 0<o:p></o:p>
    Case Is =Sheets("GROSS").Range("C8") - 1: c = 2<o:p></o:p>
    Case Is = Sheets("GROSS").Range("C8")- 2: c = 5<o:p></o:p>
    Case Is =Sheets("GROSS").Range("C8") - 3: c = 8<o:p></o:p>
    Case Else: c = -3<o:p></o:p>
<o:p></o:p>
End Select<o:p></o:p>
‘etc…etc…<o:p></o:p>
<o:p></o:p>
<o:p></o:p>
ws.Cells(iRow,1).Value = Me.ComboBox1.Value<o:p></o:p>
ws.Cells(iRow,2).Value = Me.TextBox3.Value<o:p></o:p>
ws.Cells(iRow,3).Value = b<o:p></o:p>
ws.Cells(iRow,4).Value = c<o:p></o:p>
<o:p></o:p>
'clear the data from the UserForm Textboxes<o:p></o:p>
Me.TextBox3.Value= ""<o:p></o:p>
Me.TextBox4.Value= ""<o:p></o:p>
Me.TextBox5.Value= ""<o:p></o:p>
“etc…etc…<o:p></o:p>
<o:p></o:p>
End Sub<o:p></o:p>
<o:p></o:p>
<o:p></o:p>
I can then enter the next player’s score and repeat the Sub.<o:p></o:p>
<o:p></o:p>
So, the big problem…I want to add a points system based on the players NET scores and have become stuck…in fact, my brain locks up every time I make an attempt. Any help out there?
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
You must log in or register to reply here.

Similar threads

Y
  • Question
Help me find error in this coding
Replies
6
Views
378
Peter_SSs
Peter_SSs
SemperFi
  • Solved
VBA Form TextBox needs formatting
Replies
1
Views
356
SemperFi
SemperFi
Y
  • Question
Sum the total working hours when the Qty Completed become value except 0 automatically
Replies
0
Views
329
yoon
Y
M
  • Solved
Excel Userform: certain fields need to be entered
Replies
6
Views
487
Micron
M
I
  • Solved
Textbox details should be removed if combobox selection is overwritten
Replies
7
Views
429
Akuini
Akuini

Forum statistics

Threads
1,215,455
Messages
6,124,937
Members
449,196
Latest member
Maxkapoor

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top