Sum non adjacent cells with criteria

sooshil

Board Regular
Joined
Feb 21, 2013
Messages
87
Hello

I have data to analyse game result as follows.
Every team has to play twice with the same opponent yielding Score1 and Score2.
I have to add total score of each player on a table 2 shown below.
The main problem is the number of team will be changing. If a team is added then every team will also play with the new team.
So, I want to dynamically add those team scores no matter how many times they played.
I have list of team in another sheet and this first data is dynamically generated based upon the teams listed on the other sheet.
Since the player can be added or removed, the number of scores we need to take will also be changed. That means the position(cell address) of a player in the sheet changes as a player is added or removed.
May be I am explaining more than required. If required more information, I am ready here.


ABCDEFGHIJKLMNOPQRS
1John Vs JaneJohn Vs JosephJohn Vs Regina
2TeamsScore1Score2Tie?N/R?TeamsScore1Score2Tie?N/R?TeamsScore1Score2Tie?N/R?
3John2536John3529John3842
4Jane2829Joseph4632Regina4233
5
6Jane Vs JosephJane Vs ReginaJoseph Vs Regina
7TeamsScore1Score2Tie?N/R?TeamsScore1Score2Tie?N/R?TeamsScore1Score2Tie?N/R?
8Jane2552Jane4036Joseph4236
9Joseph3641Regina3251Regina4441
10

<colgroup><col span="2"><col><col><col span="2"><col span="7"><col><col span="6"></colgroup><tbody>
</tbody>


Score1Score2
John
Jane
Joseph
Regina

<tbody>
</tbody>
 

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
10,194
Office Version
2007
Platform
Windows
Just put your equipment on sheet2 as shown below.

Sheet2
<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td > </td><td >Score1</td><td >Score2</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td >John</td><td style="text-align:right; ">98</td><td style="text-align:right; ">107</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td >Jane</td><td style="text-align:right; ">93</td><td style="text-align:right; ">117</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td >Joseph</td><td style="text-align:right; ">124</td><td style="text-align:right; ">109</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td >Regina</td><td style="text-align:right; ">118</td><td style="text-align:right; ">125</td></tr></table>

Run this macro

Note: Change Sheet1 and Sheet2 by the name of your sheets.
Code:
Sub [B][COLOR=#0000ff]Scores[/COLOR][/B]()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim r As Range, f As Range, cell As String, c As Range
  
  Set sh1 = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
  Set sh2 = Sheets("[COLOR=#ff0000]Sheet2[/COLOR]")
  Set r = sh1.UsedRange
  
  For Each c In sh2.Range("A2", sh2.Range("A" & Rows.Count).End(xlUp))
    Set f = r.Find(c.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
        cell = f.Address
        Do
            c.Offset(, 1).Value = c.Offset(, 1).Value + f.Offset(, 1).Value
            c.Offset(, 2).Value = c.Offset(, 2).Value + f.Offset(, 2).Value
            Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> cell
    End If
  Next
  MsgBox "End  "
End Sub
HOW TO INSTALL MACROs
------------------------------------
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (Scores) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "Yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.
 

sooshil

Board Regular
Joined
Feb 21, 2013
Messages
87
Hi Dante

Thanks for the response. I really appreciative your effort. That adds up the scores but there is a problem.
For the same set of players, no matter how many we run the macro, the total scores should remain same. But here, If we run the macro more than once, the total keeps increasing. Which is not what I want.

Thank you again.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
10,194
Office Version
2007
Platform
Windows
Try this please:

Code:
Sub Scores()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim r As Range, f As Range, cell As String, c As Range
  
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  Set r = sh1.UsedRange
Sh2.range(sh2.cells(2,2), sh2.cells(rows.count, columns.count)).clearcontents
  
  For Each c In sh2.Range("A2", sh2.Range("A" & Rows.Count).End(xlUp))
    Set f = r.Find(c.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
        cell = f.Address
        Do
            c.Offset(, 1).Value = c.Offset(, 1).Value + f.Offset(, 1).Value
            c.Offset(, 2).Value = c.Offset(, 2).Value + f.Offset(, 2).Value
            Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> cell
    End If
  Next
  MsgBox "End  "
End Sub
 

sooshil

Board Regular
Joined
Feb 21, 2013
Messages
87
Hi Dante

Thank you so much. :)
It worked.
I am not good at VBA. Can you let me know, if I want to change the resulting table anywhere I want (in Sheet2), then where do I need to change the VBA?
 
Last edited:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
10,194
Office Version
2007
Platform
Windows
For Each c In sh2.Range("A2", sh2.Range("A" & Rows.Count).End(xlUp))

Change "A" by the new column
Change 2 of "A2" by the initial row
 
Last edited:

sooshil

Board Regular
Joined
Feb 21, 2013
Messages
87
Hi Dante

Thank you again for your support so far. Now, my requirement for the same problem is changed. Actually I couldn't realize before that I need 'For' and 'Against' column too.
I need to get data in the second table as follows.

ABC
1Score1Score2
2ForAgainstForAgainst
3John
4Jane
5Joseph
6Regina

<tbody>
</tbody>


'For' for a player, lets say for John is sum of all the score that John has scored
'Against' for him is the sum of all the scores that his opponents scored against him.

Thank you so much Dante.
 
Last edited:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
10,194
Office Version
2007
Platform
Windows
Try this


To change the resulting table anywhere update this line: Set r2 = sh2.Range("A3", sh2.Range("A" & Rows.Count).End(xlUp))

Code:
Sub Scores()
  Dim sh1 As Worksheet, sh2 As Worksheet, r As Range, r2 As Range
  Dim f As Range, cell As String, c As Range, n As Long
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  Set r = sh1.UsedRange
[COLOR=#0000ff]  Set r2 = sh2.Range("A3", sh2.Range("A" & Rows.Count).End(xlUp))[/COLOR]
  
  r2.Offset(0, 1).Resize(r2.Rows.Count, Columns.Count - r2.Cells(1, 1).Column).ClearContents
  For Each c In r2
    Set f = r.Find(c.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
        cell = f.Address
        Do
            c.Offset(, 1).Value = c.Offset(, 1).Value + f.Offset(, 1).Value
            c.Offset(, 3).Value = c.Offset(, 3).Value + f.Offset(, 2).Value
            If f.Offset(1, 1).Value = "" Then n = -1 Else n = 1
            c.Offset(, 2).Value = c.Offset(, 2).Value + f.Offset(n, 1).Value
            c.Offset(, 4).Value = c.Offset(, 4).Value + f.Offset(n, 2).Value
            Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> cell
    End If
  Next
  MsgBox "End  "
End Sub
 

Forum statistics

Threads
1,089,438
Messages
5,408,221
Members
403,191
Latest member
fmstation

This Week's Hot Topics

  • help please
    SORRY NOT ANY GOOD AT EXCEL SO HELP WOULD BE MUCH APPRECIATED this formula is in a sheet called ignore...
  • two formulas needed
    Hello, I'll try my best to explain this: First formula needed in Sheet1 cell A2: If Sheet1 cell B2 = Sheet2 cell B2 then return a 1. If not then...
  • Dynamic Counts
    Good afternoon, we are tidying up some data & the data seems to be growing quicker than we are tidying it up! What we confirm (by reviewing it...
  • Help Excel formula eliminate duplicate values and keep only 2 identical rows.
    as picture below column A has a duplicate value. but the values are not the same as the rule. sometimes 4 rows, sometimes 10 rows or 7 or 9...
  • Macro Compile Error Sub or Function not defined
    Hello, I am trying to run macros from a validation list, all macros have been created and run perfectly on there own but I'm getting a compile...
  • Last row combined with Current Region VBA
    I'm generally happy finding the last row of data through something like Lastrow = Cells(Rows.Count, "D").End(xlUp) but I don't always receive data...
Top