# Sum non adjacent cells with criteria

#### sooshil

##### Board Regular
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.

 A B C D E F G H I J K L M N O P Q R S 1 John Vs Jane John Vs Joseph John Vs Regina 2 Teams Score1 Score2 Tie? N/R? Teams Score1 Score2 Tie? N/R? Teams Score1 Score2 Tie? N/R? 3 John 25 36 John 35 29 John 38 42 4 Jane 28 29 Joseph 46 32 Regina 42 33 5 6 Jane Vs Joseph Jane Vs Regina Joseph Vs Regina 7 Teams Score1 Score2 Tie? N/R? Teams Score1 Score2 Tie? N/R? Teams Score1 Score2 Tie? N/R? 8 Jane 25 52 Jane 40 36 Joseph 42 36 9 Joseph 36 41 Regina 32 51 Regina 44 41 10

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

 Score1 Score2 John Jane Joseph Regina

<tbody>
</tbody>

### 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
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
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
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

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
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
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
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
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

Thank you so much.

#### sooshil

##### Board Regular
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.

 A B C 1 Score1 Score2 2 For Against For Against 3 John 4 Jane 5 Joseph 6 Regina

<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
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
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``````

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