Counting total quantity of same parts

[coretex99]

Hello, I've been tasked with counting the total quantity of items we have, however many in the spreadsheet are duplicates and It cannot be done manually. For example

Number	Qty
002/242	1400​
003/20	500​
003/20	690​
004/100	1816​
004/00	9​
004/00	250​
004/00	20000​

I have set it to A-Z on Number, for example 004/00 total is 20259, any advice is muchly appreciated, thanks

 

[mehidy1437]

try with below,

Sub Unique_Values_Sumif()
'vba run or not confirmation
    Dim chkMsg As String, chkAns As Variant
    chkMsg = "This will generate the unique values/id in new sheet column A & get the total sum of last column of the slected range in new sheet colum B."
    chkAns = MsgBox(chkMsg, vbYesNo)
    Select Case chkAns
        Case vbYes
 'vba run or not confirmation
'--------------------------------------------------------------
'code here

Application.DisplayAlerts = False
Dim tb As Worksheet
Dim tb2 As Worksheet
Dim actvSheet As String

 actvSheet = ActiveSheet.Name
 'Set tb = Sheets("sheet1")
 'Set tb2 = Sheets("sheet2")
 Set tb = Sheets(actvSheet)
 
  'Dim lrow As Long
  Dim rSelection As Range, lColNo As Integer, formulalColNo As Integer, fColNo As Integer, formulafColNo As Integer
  'lrow = tb.Cells(tb.Rows.Count, 1).End(xlUp).Row
  'tb.Range("A2:A" & lrow).Copy tb2.Range("A2")
  'Check that a range is selected
  If Selection.Columns.count < 2 Then
    MsgBox "Please select a range first, you have slected only 1 column, column must be at least 2", vbOKOnly, "Selecton Check"
    Exit Sub
  End If
 
  'Store the selected range
  Set rSelection = Selection
  fColNo = rSelection.Column
  formulafColNo = fColNo - 2
  lColNo = rSelection(rSelection.count).Column
  formulalColNo = lColNo - 2
 
  Set tb2 = Worksheets.Add(Type:=xlWorksheet, After:=Application.ActiveSheet)
  rSelection.Copy tb2.Range("A3")

On Error Resume Next
With tb2
    .Range("A3:A5000").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp
    .Range("B1:Z5000").ClearContents
    .Range("A3").CurrentRegion.RemoveDuplicates 1
    With .Range(.Range("B3"), .Range("A3").End(xlDown).Offset(, 1))
        '.FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)"
        .FormulaR1C1 = "=SUMIF('" & actvSheet & "'!C[" & formulafColNo & "]:C[" & formulafColNo & "],RC[-1],'" & actvSheet & "'!C[" & formulalColNo & "]:C[" & formulalColNo & "])"
    End With
     'Delete column
    '.Range("C1:Z1").EntireColumn.Delete
     'Autofit column
    .Columns("A").AutoFit
    .Range("B1").Formula = "=SUM(B3:B5000)"
    .Range("A1").Formula = "=COUNTA(A3:A5000)"
End With
Application.DisplayAlerts = True

Done:
Exit Sub
'code here
'-----------------------------------------------------------------
'vba run or not confirmation
    Case vbNo
        GoTo Quit:
    End Select
Quit:
'vba run or not confirmation
End Sub

 

[coretex99]

try with below,

Sub Unique_Values_Sumif()
'vba run or not confirmation
    Dim chkMsg As String, chkAns As Variant
    chkMsg = "This will generate the unique values/id in new sheet column A & get the total sum of last column of the slected range in new sheet colum B."
    chkAns = MsgBox(chkMsg, vbYesNo)
    Select Case chkAns
        Case vbYes
'vba run or not confirmation
'--------------------------------------------------------------
'code here

Application.DisplayAlerts = False
Dim tb As Worksheet
Dim tb2 As Worksheet
Dim actvSheet As String

actvSheet = ActiveSheet.Name
'Set tb = Sheets("sheet1")
'Set tb2 = Sheets("sheet2")
Set tb = Sheets(actvSheet)

  'Dim lrow As Long
  Dim rSelection As Range, lColNo As Integer, formulalColNo As Integer, fColNo As Integer, formulafColNo As Integer
  'lrow = tb.Cells(tb.Rows.Count, 1).End(xlUp).Row
  'tb.Range("A2:A" & lrow).Copy tb2.Range("A2")
  'Check that a range is selected
  If Selection.Columns.count < 2 Then
    MsgBox "Please select a range first, you have slected only 1 column, column must be at least 2", vbOKOnly, "Selecton Check"
    Exit Sub
  End If

  'Store the selected range
  Set rSelection = Selection
  fColNo = rSelection.Column
  formulafColNo = fColNo - 2
  lColNo = rSelection(rSelection.count).Column
  formulalColNo = lColNo - 2

  Set tb2 = Worksheets.Add(Type:=xlWorksheet, After:=Application.ActiveSheet)
  rSelection.Copy tb2.Range("A3")

On Error Resume Next
With tb2
    .Range("A3:A5000").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp
    .Range("B1:Z5000").ClearContents
    .Range("A3").CurrentRegion.RemoveDuplicates 1
    With .Range(.Range("B3"), .Range("A3").End(xlDown).Offset(, 1))
        '.FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)"
        .FormulaR1C1 = "=SUMIF('" & actvSheet & "'!C[" & formulafColNo & "]:C[" & formulafColNo & "],RC[-1],'" & actvSheet & "'!C[" & formulalColNo & "]:C[" & formulalColNo & "])"
    End With
     'Delete column
    '.Range("C1:Z1").EntireColumn.Delete
     'Autofit column
    .Columns("A").AutoFit
    .Range("B1").Formula = "=SUM(B3:B5000)"
    .Range("A1").Formula = "=COUNTA(A3:A5000)"
End With
Application.DisplayAlerts = True

Done:
Exit Sub
'code here
'-----------------------------------------------------------------
'vba run or not confirmation
    Case vbNo
        GoTo Quit:
    End Select
Quit:
'vba run or not confirmation
End Sub

Wow, that works straight up, thank you very much, amazed by how much code that takes!! Many thanks to you sir

 

[mehidy1437]

You are welcome.

 

[Peter_SSs]

You could also just use a few clicks to implement Excel's built-in Pivot Table feature (on the Insert ribbon tab)

20 09 14.xlsm
	A	B	C	D	E
1	Number	Qty		Sum of Qty
2	002/242	1400		Number	Total
3	003/20	500		002/242	1400
4	003/20	690		003/20	1190
5	004/100	1816		004/00	20259
6	004/00	9		004/100	1816
7	004/00	250		Grand Total	24665
8	004/00	20000
Total Qty

 

[alansidman]

Another Option is to use Power Query/Get and Transform.

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Qty", Int64.Type}}),
    #"Grouped Rows" = Table.Group(#"Changed Type", {"Number"}, {{"Total", each List.Sum([Qty]), type nullable number}})
in
    #"Grouped Rows"

Book6
	A	B
1	Number	Total
2	002/242	1400
3	003/20	1190
4	004/100	1816
5	004/00	20259
Sheet2