Overall rankings updating automatically after entering new data?

[dartistik]

Hello all,

I'm not that great with Excel, so not sure if this is possible at all (or just very complicated), but here goes.

I'm doing rankings for darts players in the Danish leagues, and I've got the the overall rankings in sheet 1 and then I create a new sheet for every day matches are played. What I'd like is that the sheet with the overall rankings recognizes the license number (a unique ID) of the players when I enter their data in another sheet for each day, and then adds the data from that to the data in the overall rankings.

The way I'm doing it at the moment I have to manually find every player in the overall rankings and then add the numbers for hundreds of players each time.

Here's a screenshot of the overall rankings sheet from a test workbook I'm working on for next season, results from the 1st day have been put in:

I then create new sheets for each day matches are being played:

And when I put in the data from that particular day, I'd ideally like for the overall rankings sheet to add the numbers in column G, H, J, K and P in these sheets:

...to the corresponding colomns H, I, K, L and R for each player in the overall rankings sheet. The rest of the columns are calculated by formulas.

In essence, using Excel as a kind of database, so I don't have to manually add all the numbers to each and every player after every day they've played. Like I said, not sure if it's possible at all, and probably there'll be a problem when a new player than wasn't on the overall rankings previously plays on a given day too.

Let me know if I'm just daydreaming here

 

[B___P]

May be I guessed what you did. Did you put macro in a different workbook to keep your workbook extension as xlsx? It is the only thing that could rise that error.

Here the code with amendments:

Option Explicit
Sub updateSR()
Dim y As String
Dim x As Long
Dim z As Long
Dim dayWS As Worksheet
Dim SRWS As Worksheet
Dim myrange As Range
Dim FOUND As Boolean
Dim lrdayWS As Long
Dim lrSR As Long

Set myrange = Application.InputBox(prompt:="select a cell in sheet to integrate", Type:=8)
y = myrange.Worksheet.Name
Set dayWS = Worksheets(y)
Set SRWS = Worksheets("Samlet rangliste")
lrdayWS = dayWS.Cells(Rows.Count, 3).End(xlUp).Row
 For x = 4 To lrdayWS
    lrSR = SRWS.Cells(Rows.Count, 4).End(xlUp).Row
    FOUND = False
    For z = 4 To lrSR
    'FOUND = False
        If dayWS.Cells(x, 3).Value = SRWS.Cells(z, 4).Value Then
            SRWS.Cells(z, 4).Offset(0, 4).Value = SRWS.Cells(z, 4).Offset(0, 4).Value + dayWS.Cells(x, 3).Offset(0, 4).Value
            SRWS.Cells(z, 4).Offset(0, 5).Value = SRWS.Cells(z, 4).Offset(0, 5).Value + dayWS.Cells(x, 3).Offset(0, 5).Value
            SRWS.Cells(z, 4).Offset(0, 7).Value = SRWS.Cells(z, 4).Offset(0, 7).Value + dayWS.Cells(x, 3).Offset(0, 7).Value
            SRWS.Cells(z, 4).Offset(0, 8).Value = SRWS.Cells(z, 4).Offset(0, 8).Value + dayWS.Cells(x, 3).Offset(0, 8).Value
            SRWS.Cells(z, 4).Offset(0, 14).Value = SRWS.Cells(z, 4).Offset(0, 14).Value + dayWS.Cells(x, 3).Offset(0, 13).Value
            FOUND = True
        End If
    Next z
        If FOUND = False Then
            SRWS.Range([COLOR=#ff0000]SRWS.[/COLOR]Cells(lrSR, "B"), [COLOR=#ff0000]SRWS.[/COLOR]Cells(lrSR + 1, "V")).FillDown
            SRWS.Range([COLOR=#ff0000]SRWS.[/COLOR]Cells(lrSR, "B"), [COLOR=#ff0000]SRWS.[/COLOR]Cells(lrSR + 1, "P")).Borders(xlInsideHorizontal).Weight = xlThin
            SRWS.Cells(lrSR + 1, 3).Value = SRWS.Cells(lrSR, 3).Value + 1
            SRWS.Cells(lrSR + 1, 4).Offset(0, 0).Value = dayWS.Cells(x, 3).Offset(0, 0).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 1).Value = dayWS.Cells(x, 3).Offset(0, 1).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 2).Value = dayWS.Cells(x, 3).Offset(0, 2).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 4).Value = dayWS.Cells(x, 3).Offset(0, 4).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 5).Value = dayWS.Cells(x, 3).Offset(0, 5).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 7).Value = dayWS.Cells(x, 3).Offset(0, 7).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 8).Value = dayWS.Cells(x, 3).Offset(0, 8).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 14).Value = dayWS.Cells(x, 3).Offset(0, 13).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 16).Value = ""
            SRWS.Cells(lrSR + 1, 4).Offset(0, 18).Value = ""
        End If
 Next x
End Sub

As a suggestion, move range from M49:O50 to AA10:AC11 and change formulas from =(SUM(R4:R47))/(SUM(K4:K47)) to =(SUM(R:R))/(SUM(K:K)) and =AVERAGE(O4:O47) to =AVERAGE(O:O)

There are minor amendments for new player.
Hope this helps and you like
Have a nice week

 

[B___P]

What about inserting this line of code before the end of last IF block?

            SRWS.Cells(lrSR + 1, 4).Offset(0, 12).Value = "NEW"

Cheers

 

[dartistik]

B___P, you are an absolute genius.

It works great now:

Could I ask you for one more small amendment? When it adds new players to the list, could you make it put a - in columns T and V (like I have added in the screenshot above)?

Thanks again for your excellent work!

 

[B___P]

Hi dartistik,

here the full code with required amendments

Option Explicit
Sub updateSR()
Dim y As String
Dim x As Long
Dim z As Long
Dim dayWS As Worksheet
Dim SRWS As Worksheet
Dim myrange As Range
Dim FOUND As Boolean
Dim lrdayWS As Long
Dim lrSR As Long

Set myrange = Application.InputBox(prompt:="select a cell in sheet to integrate", Type:=8)
y = myrange.Worksheet.Name
Set dayWS = Worksheets(y)
Set SRWS = Worksheets("Samlet rangliste")
lrdayWS = dayWS.Cells(Rows.Count, 3).End(xlUp).Row
 For x = 4 To lrdayWS
    lrSR = SRWS.Cells(Rows.Count, 4).End(xlUp).Row
    FOUND = False
    For z = 4 To lrSR
    'FOUND = False
        If dayWS.Cells(x, 3).Value = SRWS.Cells(z, 4).Value Then
            SRWS.Cells(z, 4).Offset(0, 4).Value = SRWS.Cells(z, 4).Offset(0, 4).Value + dayWS.Cells(x, 3).Offset(0, 4).Value
            SRWS.Cells(z, 4).Offset(0, 5).Value = SRWS.Cells(z, 4).Offset(0, 5).Value + dayWS.Cells(x, 3).Offset(0, 5).Value
            SRWS.Cells(z, 4).Offset(0, 7).Value = SRWS.Cells(z, 4).Offset(0, 7).Value + dayWS.Cells(x, 3).Offset(0, 7).Value
            SRWS.Cells(z, 4).Offset(0, 8).Value = SRWS.Cells(z, 4).Offset(0, 8).Value + dayWS.Cells(x, 3).Offset(0, 8).Value
            SRWS.Cells(z, 4).Offset(0, 14).Value = SRWS.Cells(z, 4).Offset(0, 14).Value + dayWS.Cells(x, 3).Offset(0, 13).Value
            FOUND = True
        End If
    Next z
        If FOUND = False Then
            SRWS.Range(SRWS.Cells(lrSR, "B"), SRWS.Cells(lrSR + 1, "V")).FillDown
            SRWS.Range(SRWS.Cells(lrSR, "B"), SRWS.Cells(lrSR + 1, "P")).Borders(xlInsideHorizontal).Weight = xlThin
            SRWS.Cells(lrSR + 1, 3).Value = SRWS.Cells(lrSR, 3).Value + 1
            SRWS.Cells(lrSR + 1, 4).Offset(0, 0).Value = dayWS.Cells(x, 3).Offset(0, 0).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 1).Value = dayWS.Cells(x, 3).Offset(0, 1).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 2).Value = dayWS.Cells(x, 3).Offset(0, 2).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 4).Value = dayWS.Cells(x, 3).Offset(0, 4).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 5).Value = dayWS.Cells(x, 3).Offset(0, 5).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 7).Value = dayWS.Cells(x, 3).Offset(0, 7).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 8).Value = dayWS.Cells(x, 3).Offset(0, 8).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 14).Value = dayWS.Cells(x, 3).Offset(0, 13).Value
            SRWS.Cells(lrSR + 1, 4).Offset(0, 16).Value = "-"
            SRWS.Cells(lrSR + 1, 4).Offset(0, 18).Value = "-"
            SRWS.Cells(lrSR + 1, 4).Offset(0, 12).Value = "NEW"
        End If
 Next x
End Sub

Hope you like it

Cheers

 

[dartistik]

Hi B___P,

Just wanted to thank you again - you have saved me quite a few hours of work over the next year or so! As far as I can see it now does everything I want perfectly

Best regards