Overall rankings updating automatically after entering new data?

D

dartistik

New Member
Joined
May 22, 2017
Messages
16
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:

2w3u7g8.png


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

2l8eux4.png


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:

16i9ybn.png


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

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
Hi dartistik,
I made a code that may work for you

Code: 
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
    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.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
        End If
 Next x
End Sub

When macro runs, it will ask to select a cell (whatever cell you want) in a daily worksheet and then integrates data to Samlet rangliste. If a player is already in masterworksheet it sums his data. If player is a new one it adds a new row.

Hope this helps and you like it
Have a nice week
 
Upvote 0
ExcelIsFun !
Watch MagicTrick 1417 for starters and then maybe the two other referenced ones to get an idea of some really expanded capabilities of Excel.
I would personally work-up a Pivot Table instead of a Macro, but both need Run/Refresh.
The MagicTrick 1417 uses formulas, so they update live!
 
Upvote 0
Hello B___P,

Thank you for you effort - I just tried it out and it ALMOST does what I wanted! It does indeed sum up the numbers wanted for the players already in the overall rankings, but it also pastes the entire list of players/numbers from the sheet I update from underneath the rankings:

1z307ir.png


Also, it doesn't make a new row in the list for new players - for example, Justin Thurley (license no. 2120) in the above screenshot is a new player, but he hasn't been added to the overall rankings, only in the list pasted beneath it.
 
Upvote 0
Hi dartistik
here the code amended

Code: 
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.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
        End If
 Next x
End Sub


Now it adds values to already present players and puts new players at the end of table.
I think the smartest thing to do is to prolong table with its formulas and formats and leave macro to fill empty cells

Cheers
 
Upvote 0
I built a patch that may work for you

Code: 
Option Explicit
Dim lrSR As Long
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
        Call insertR
            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
        End If
 Next x
End Sub

Private Sub insertR()
    Application.CutCopyMode = False
    Worksheets("Samlet rangliste").Rows(lrSR).EntireRow.Copy
    Worksheets("Samlet rangliste").Rows(lrSR + 1).Select
    ActiveSheet.Paste
    Worksheets("Samlet rangliste").Range(Cells(lrSR + 1, 2), Cells(lrSR + 1, 16)).Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Try in and let me know.

Cheers
 
Upvote 0
I hate that kind of patch and converted to a cleverer way...
Code: 
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
           [COLOR=#ff0000] SRWS.Range(Cells(lrSR, "B"), Cells(lrSR + 1, "V")).FillDown
            SRWS.Range(Cells(lrSR, "B"), Cells(lrSR + 1, "P")).Borders(xlInsideHorizontal).Weight = xlThin[/COLOR]
            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
        End If
 Next x
End Sub

Hope this will suite your needs and you like it
 
Upvote 0
Hi B___P,

Thank you for your continued efforts! The code in post #5 now updates the values for players already in the list, and pastes the new players below the list. Your newest code (post #7), however, gives me this error:

29fvzh1.png


Is it at all possible to get it to insert the rows of the new players in the actual list, so I get the formatting and formulas working for the new players instantly, or am I asking too much here? :)
 
Upvote 0
Code in post #7 works flawless for me. The difference from code in post #5 is in only in the red lines. If you click debug does vba highlight one of those lines? What version of excel do you have? Can you post your worksheet in a filesharing site?
But before change macro name and put it in a new module.

BTW

-- removed inline image ---


cheers
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Soccer League Workbook
Replies
1
Views
176
hagia_sofia
hagia_sofia
S
  • Solved
Formula for next upcoming fixture
Replies
5
Views
217
Fluff
Fluff
N
  • Question Question
Auto Sort for Leaderboard
Replies
0
Views
529
NTLKnight
N
confuxion
  • Question Question
Best way to make all-time leading scorers sheet from multiple sheets
2 3 4
Replies
33
Views
962
felixstraube
F
M
  • Question Question
Dynamic Update to Range in RANK Based on Date
Replies
0
Views
458
multifidus
M

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

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