Best Solution: Database, Pivot Table, or Neither

kilobravo

New Member
Joined
Jun 25, 2012
Messages
18
First post for me..long-time Excel user but only semi-literate with the use of Lists or Pivot Tables. My question is what would be the best direction to go for my needs. To wit, I help run a competitive rifle/handgun shooting club and as the "Scores Guy," I would like to improve and automate the manual method I've been using.

To give an idea of the task at hand, we typically have 25 shooters each of which will shoot five stages (ST) which generates 125 rows of data. A shot timer records the raw time (TIME) and there are multiple types of penalties all of which can add additional time to the score. A lower score, i.e., time is better. The final score is the sum of the raw time plus penalties and the penalties field (PEN) is calculated by multiplying penalty factor assignments to each type of penalty times the number of occurrences.

This is a link to a portion of a sample data file... (temp.xls)

and here is a link to an example of the html file we use to post the scores. (scores link)

Right now, raw data is entered manually from random scoresheets in a stack, one line at a time, and that data is then replicated via multiple formulas in multiple sheets of the same workbook where calculations and totalling is done followed by additional sheets where sorting is done and finally, an additional sheet for the Web output file using the gray bars you see in the html link.

So, my question is whether using a List or Pivot Table would be better or, whether neither is appropriate. I'm not at all VBA savvy but I've done a good bit of dBASE and other programming in the distant past so I'm at least teachable. :) Ultimately, I'd love to have a turn key system that a non-techie could use to do our scores but I realize that's a pie in the sky goal. However, I'd be happy with some guidance on how to do this in an efficient manner even if it means I have to be the operator during the process, i.e., dialog boxes for entry, VBA buttons for manipulating the data and producing the HTML output.

Any guidance would be greatly appreciated.

KB
 
The double shooters are not a problem with my manual routines but clearly they're a problem for an automated parsing, especially those with the same name and the same DIV. So, I plan to enter any future shooter info like this by appending " G2" to the shooter name for the second gun and that should eliminate the problem. Consequently, I have uploaded a new test.xls with those changes.

KB
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Ok. I have fixed a few issues and added some enhancements
1. Based on your example, the macro looks for the data in a tab called "Data" rather than "RawData"
2. There is no need to have tabs called "Results" and "Summary" . The Macro will create them.
3. The macro will automatically determine how many stages there are and adjust accordingly.
4. DNF is now properlly populate for the Score the Summary sheet
5. The Macro can now handle the same Shooter in Different Division for the Summary. You will still need to add the G2 for a Shooter that uses a different gun in the Same Division

Code:
Option Explicit
Type typeRec
    Key As String
    Name As String
    Div As String
    Cnts(9) As Variant
End Type
Dim Wb As Workbook
Dim WsRawData As Worksheet
Sub Process()
    Dim WsDest As Worksheet
    Dim intSt As Integer
    Dim SrcLastRow As Long
    Dim DestLastRow As Long
    
    Set Wb = ThisWorkbook
    Set WsRawData = Wb.Worksheets("Data")
    
    Call SetUp
    
    WsRawData.Activate
    WsRawData.Range("A1").Select
    
    'Turn the filters off
    If WsRawData.FilterMode Then
        WsRawData.Range("A1").AutoFilter
    End If
    
    Set WsDest = Wb.Worksheets("Results")
    WsDest.Cells.Clear
    
    WsRawData.Activate
    WsRawData.AutoFilterMode = False
    WsRawData.UsedRange.Activate
    
    SrcLastRow = WsRawData.Cells(WsDest.Rows.Count, "A").End(xlUp).Row
    WsRawData.Range("A1:L" & SrcLastRow).Sort Key1:=WsRawData.Range("B1"), Key2:=WsRawData.Range("L1"), Header:=xlYes
    
    For intSt = 1 To GetMaxStage(WsRawData, "C")
        Selection.AutoFilter Field:=3, Criteria1:=intSt 'Field 3 is the 'Stage'
        
        DestLastRow = WsDest.Cells(WsDest.Rows.Count, "B").End(xlUp).Row
        WsDest.Cells(DestLastRow + 2, "A") = "Stage: " & intSt
        
        'Data
        WsRawData.AutoFilter.Range.Copy Destination:=WsDest.Range("B" & DestLastRow + 3)
    Next intSt
    
    'Turn the filters off
    If WsRawData.FilterMode Then
        WsRawData.Range("A1").AutoFilter
    End If
    
    
    '********************************
    ' Summary Tables
    '********************************
    Dim RowNo As Long
    Dim Idx As Long
    Dim Rec() As typeRec
    Dim I As Long
    Dim Key As String
    
    ReDim Rec(0)
    
    
    For RowNo = 2 To SrcLastRow
        Key = WsRawData.Cells(RowNo, "A") & "~" & WsRawData.Cells(RowNo, "B")
        Idx = FindIdx(Key, Rec)
        Rec(Idx).Name = WsRawData.Cells(RowNo, "A")
        Rec(Idx).Div = WsRawData.Cells(RowNo, "B")
        
        If UCase(Rec(Idx).Cnts(9)) = "DNF" Or UCase(WsRawData.Cells(RowNo, "L")) = "DNF" Then
            Rec(Idx).Cnts(9) = "DNF"
        Else
            For I = 1 To 9
                Rec(Idx).Cnts(I) = Rec(Idx).Cnts(I) + Val(WsRawData.Cells(RowNo, I + 3))
            Next I
        End If
        
            
    Next RowNo
    
    Dim WsSummary As Worksheet
    
    Set WsSummary = Wb.Worksheets("Summary")
    WsSummary.Cells.Clear
    WsRawData.Rows(1).Copy Destination:=WsSummary.Range("A1")
    
    For RowNo = 1 To UBound(Rec)
        WsSummary.Cells(RowNo + 1, 1) = Rec(RowNo).Name
        WsSummary.Cells(RowNo + 1, 2) = Rec(RowNo).Div
        For I = 1 To 9
            If Rec(RowNo).Cnts(I) > 0 Then
                WsSummary.Cells(RowNo + 1, I + 3) = Rec(RowNo).Cnts(I)
            End If
        Next I
    Next RowNo
    WsDest.Activate
    WsDest.Range("A1").Activate
    
    MsgBox "Complete", vbInformation
End Sub
Function FindIdx(Key As String, Rec() As typeRec) As Long
    Dim I As Long
    
    For I = 1 To UBound(Rec)
        If Trim(Key) = Rec(I).Key Then
            FindIdx = I
            Exit Function
        End If
    Next I
    
    ReDim Preserve Rec(I)
    Rec(I).Key = Trim(Key)
    FindIdx = I
End Function
Function SetUp()
    Dim wName As Variant
    Dim I As Integer
    
    wName = Array("Results", "Summary")
    For I = 0 To UBound(wName)
        Call DeleteWS(wName(I))
        Call AddWs(wName(I))
    Next I
End Function
Function AddWs(WsName As Variant)
    Wb.Worksheets.Add after:=Wb.Worksheets(Wb.Worksheets.Count)
    Wb.Worksheets(Wb.Worksheets.Count).Name = WsName
End Function
Function DeleteWS(WsName As Variant)
    Application.DisplayAlerts = False
    On Error Resume Next
    Wb.Worksheets(WsName).Delete
    
    Application.DisplayAlerts = True
End Function
Function GetMaxStage(Ws As Worksheet, MaxStageCol As String) As Integer
    Dim RowNo As Long
    Dim MaxStage As Integer
    
    For RowNo = 2 To Ws.Cells(Ws.Rows.Count, "B").End(xlUp).Row
        If MaxStage < Ws.Cells(RowNo, MaxStageCol) Then
            MaxStage = Ws.Cells(RowNo, MaxStageCol)
        End If
    Next RowNo
    GetMaxStage = MaxStage
End Function
 
Upvote 0
Absolutely BRILLIANT, DB...it worked perfectly! The only thing left is the output to print and to the Web. You're a GENIUS, amigo!
 
Upvote 0
They are indeed!

As for your question, I have been using this template with sheets for the output and while amateur at best, it was good enough. As for the time to go from last scoresheet entry to importing the final table from the WEB PUBLISH tab into DW for posting of the HTML file, probably 30-45 minutes, assuming I didn't screw something up. That included all the manual ranking entries, removing blank lines manually, sorting, etc.

Plus, because my template required that we enter all stage 1 first, stage 2, etc., it couldn't be used at our big annual matches where random completed scoresheets come in a handful at a time from random stages so that scoring had to all be done manually. Ditto for the hard copy printouts we need at the big matches for the competitors to review before they all agree there are no challenges. Again, all manually generated reports. So for a big match, it would probably take me 90 minutes or more to be ready to print hard copies. So this year, my goal has been to gin up a routine that would automate as much of that as possible and, most importantly, allow me to use the same routine for both the monthly matches and the big annual matches by being able to enter scoresheets for any shooter and any stage at any time.

Obviously, my first post on this forum is proof that I have been unable to accomplish this myself and clearly, you're the guy we need in our club! <grin> Seriously though, I can't thank you enough for all this wonderful coding and I really do want to do something for you in return so let me know.
 
Last edited:
Upvote 0
Thanks for the explaination.... I hope what we put together works for you. Let me know if you need anythis else

Bill
 
Upvote 0
It is I who owe you the thanks, BD and I'm going to get out my VBA books and see if I can manage to gin up a second macro to generate the output from the data in your wonderful Process routine. But, I WILL try and go it solo and not bother you again with more questions unless it's absolutely impossible for me to figure out.

Thanks SO much!
 
Upvote 0

Forum statistics

Threads
1,216,026
Messages
6,128,363
Members
449,444
Latest member
abitrandom82

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