How to fix this code to combine 2 columns and add sum

[kholden1]

I found this code below on the website, I am trying to combine the first 2 columns and add the additional quantities to create 1 row of the same information. Can someone please help me figure out what I am doing wrong? thank you!

Sub MergeRowsSumValues()
    Dim objSelectedRange As Excel.Range
    Dim varAddressArray As Variant
    Dim nStartRow, nEndRow As Integer
    Dim strFirstColumn, strSecondColumn, strThirdColumn As String
    Dim objDictionary As Object
    Dim nRow As Integer
    Dim objNewWorkbook As Excel.Workbook
    Dim objNewWorksheet As Excel.Worksheet
    Dim varItems, varValues As Variant

    On Error GoTo ErrorHandler
    Set objSelectedRange = Excel.Application.Selection
    varAddressArray = Split(objSelectedRange.Address(, False), ":")
    nStartRow = Split(varAddressArray(0), "$")(1)
    strFirstColumn = Split(varAddressArray(0), "$")(0)
    nEndRow = Split(varAddressArray(1), "$")(1)
    strSecondColumn = Split(varAddressArray(1), "$")(0)
  

    Set objDictionary = CreateObject("Scripting.Dictionary")

    For nRow = nStartRow To nEndRow
        strItem = ActiveSheet.Range(strFirstColumn & nRow).Value
        strValue = ActiveSheet.Range(strSecondColumn & nRow).Value

        If objDictionary.Exists(strItem) = False Then
            objDictionary.Add strItem, strValue
        Else
            objDictionary.Item(strItem) = objDictionary.Item(strItem) + strValue
        End If
    Next

    Set objNewWorkbook = Excel.Application.Workbooks.Add
    Set objNewWorksheet = objNewWorkbook.Sheets(1)

    varItems = objDictionary.keys
    varValues = objDictionary.items

    nRow = 0
    For i = LBound(varItems) To UBound(varItems)
        nRow = nRow + 1
        With objNewWorksheet
            .Cells(nRow, 1) = varItems(i)
            .Cells(nRow, 2) = varItems(i)
            .Cells(nRow, 3) = varValues(i)
          
        End With

EDIT:
I just wanted to mention that in the first column, not all are numbered part numbers, most of them would be items

 

[Max1616]

Give this a try:

Sub Consolidate()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lrow As Long
Dim i As Long

Set ws1 = ActiveSheet
Set ws2 = ActiveWorkbook.Worksheets.Add
ws2.Name = "Consolidated View"

lrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row


ws1.Range("A1:B" & lrow).Copy ws2.Range("A1")


ws2.Range("A:B").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
ws2.Range("C1") = "Full Part Name"
ws2.Range("D1") = "Total QTY"

lrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lrow
    ws2.Cells(i, 3) = ws2.Cells(i, 2) & " " & ws2.Cells(i, 1)
    ws2.Cells(i, 4) = Application.SumIfs(ws1.Range("C:C"), ws1.Range("A:A"), ws2.Cells(i, 1), ws1.Range("B:B"), ws2.Cells(i, 2))


Next i

End Sub

I think this is accomplishing what you are trying to do.

 

[kholden1]

YES! This is perfect! Thank you SOO much, you have saved me hours of work!

 

[Max1616]

Glad I could help!

 

[kholden1]

Hi! @Max1616 helped me with this earlier this year. I wanted to see if someone would be available to help me make one adjustment to my previous VBA code. I now have a 4th column with initials that I need to combine. Below is a preview. Normally my code has the first 3 columns and combines all of the part numbers and qtys based on different manufacturers. I would now additionally need it to combine initials as well.

Part number	Manufacturer	qty	initials
abc 1234	Sony	24	AK
abc 1234	Sony	55	AK
abc 1234	Sony	99	AB
abc 1234	Tag	100	AB

from the same parameters as the VBA code above.

 

[kholden1]

Hi, would anyone be able to take a look at this edit for me, please?

 

[Max1616]

Give this a try

Sub Consolidate()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lrow As Long
Dim i As Long

Set ws1 = ActiveSheet
Set ws2 = ActiveWorkbook.Worksheets.Add
ws2.Name = "Consolidated View"

lrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row


ws1.Range("A1:D" & lrow).Copy ws2.Range("A1")

ws2.Range("C:C").Delete
ws2.Range("A:C").RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes
ws2.Range("D1") = "Full Part Name"
ws2.Range("E1") = "Total QTY"

lrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lrow
    ws2.Cells(i, 4) = ws2.Cells(i, 2) & " " & ws2.Cells(i, 1) & " " & ws2.Cells(i, 3)
    ws2.Cells(i, 5) = Application.SumIfs(ws1.Range("C:C"), ws1.Range("A:A"), ws2.Cells(i, 1), ws1.Range("B:B"), ws2.Cells(i, 2), ws1.Range("D:D"), ws2.Cells(i, 3))

Next i

End Sub