Return values without duplicates

[Santa]

Hi everyone,
Please give me a hand on this matter:
I have this worksheet with 4 sheets:
on first 3, I have a list of names like this:
Sheet1:
A B C
1 Danny 5
2 Alex 4
3 John 3
4 Alex 2

Sheet2:
A B C
1 George 7
2 Alex 2
3 Danny 1
4 John 4

Sheet3:
A B C
1 Danny 3
2 Alex 2
3 George 11

And I want in the last sheet, to have a list like:
Alex
Danny
George
John
and in the B column the sum of all the values next to their names in the other sheets...

Lots of thanks!

 

[GTO]

Try:

Option Explicit
    
Sub exa()
Dim _
DIC         As Object, _
wks         As Worksheet, _
i           As Long, _
aryVals     As Variant, _
tmpNames    As Variant, _
tmpVals     As Variant
    
    
    Set DIC = CreateObject("Scripting.Dictionary")
    '//                                         Change sheet names to suit.         //
    For Each wks In ThisWorkbook.Worksheets(Array("Sheet1", "Sheet2", "Sheet3"))
        '// Presumes a header row and that names are in B col.                      //
        aryVals = Range(wks.Range("B2"), wks.Cells(wks.Rows.Count, "B").End(xlUp).Offset(, 1)).Value
        
        '// Use the dictionary's keys to store the names, and as long as there's a valid//
        '// number next to a name, use ea key's item to store the vals.                 //
        For i = 1 To UBound(aryVals, 1)
            If IsNumeric(aryVals(i, 2)) Then
                DIC.Item(aryVals(i, 1)) = DIC.Item(aryVals(i, 1)) + aryVals(i, 2)
            End If
        Next
    Next
    
    '// Flip keys/items into temp arrays to retain late-binding.                        //
    tmpNames = DIC.Keys
    tmpVals = DIC.Items
    '// Re-use aryVals                                                                  //
    ReDim aryVals(1 To DIC.Count, 1 To 2)
    
    '// Loop in the corresponding data from our tmp arrays, add a sheet and plunk in the//
    '// returned sums.                                                                  //
    For i = 1 To DIC.Count
        aryVals(i, 1) = tmpNames(i - 1)
        aryVals(i, 2) = tmpVals(i - 1)
    Next
    With ThisWorkbook
        Set wks = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count), Type:=xlWorksheet)
    End With
    wks.Range("A2").Resize(UBound(aryVals, 1), UBound(aryVals, 2)).Value = aryVals
End Sub

 

[MickG]

Try this:-
Results Start "F1" sheet (3).

[COLOR="Navy"]Sub[/COLOR] MG16May26
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] sht [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] S [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
sht = Array("Sheet1", "Sheet2", "Sheet3")
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] S = 0 To UBound(sht)
        [COLOR="Navy"]With[/COLOR] Sheets(sht(S))
            [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("B1"), .Range("b" & Rows.Count).End(xlUp))
        [COLOR="Navy"]End[/COLOR] With
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
                [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                    .Add Dn.Value, Dn(, 2)
                [COLOR="Navy"]Else[/COLOR]
                    .Item(Dn.Value) = .Item(Dn.Value) + Dn(, 2)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]Next[/COLOR] S
Sheets("Sheet3").Range("F1").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[ayazgreat]

Hi try this

Aussming last sheet name is result.

Sub SheetsSum()
Dim ws As Worksheet, a, b(), i As Long, n As Long, maxCol As Long
On Error Resume Next
Application.DisplayAlerts = False
Sheets("result").Delete
Application.DisplayAlerts = True
On Error GoTo 0
ReDim b(1 To Rows.Count, 1 To 2)
With CreateObject("Scripting.Dictionary")
    .CompareMOde = vbTextCompare
    For Each ws In Sheets
        a = ws.Range("a1").CurrentRegion.Resize(, 2).Value
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                n = n + 1: b(n, 1) = a(i, 1)
                .Add a(i, 1), n
            End If
            x = .Item(a(i, 1))
            b(x, 2) = b(x, 2) + a(i, 2)
                  
        Next
    Next
End With
Sheets.Add().Name = "result"
With Sheets("result").Range("a1")
    .Resize(, 2).Value = [{"Name","Total"}]
    .Offset(1).Resize(n, 2).Value = b
End With
End Sub

 

[Santa]

Thanks!