Add 1 more column to Code

[dantb]

Hello all: The below code combines duplicates, it Looks in Column A (Item Number), combines Column B (Quantities) and puts it on sheet2. My Question is can this be modified to add Column C (Description) data on sheet2 also? Thanks Dan

Sub test()
Dim dic As Object, x, y
Dim r As Range
Set dic = CreateObject("Scripting.Dictionary")
For Each r In Range("A1", Range("A65536").End(xlUp))
If Not IsEmpty(r) Then
If Not dic.exists(r.Value) Then
dic.Add r.Value, r.Offset(, 1).Value
Else
dic(r.Value) = dic(r.Value) + r.Offset(, 1).Value
End If
End If
Next
x = dic.keys: y = dic.items
If dic.Count < 1 Then Exit Sub
With Sheets("sheet2").Range("a1")
.Resize(UBound(x) + 1).Value = Application.Transpose(x)
.Offset(, 1).Resize(UBound + 1).Value = _
Application.Transpose
End With
End Sub

 

[jindon]

try

Sub testx()
Dim dic As Object, w(), x
Dim r As Range
Set dic = CreateObject("Scripting.Dictionary")
For Each r In Range("A1", Range("A65536").End(xlUp))
    If Not IsEmpty(r) Then
        If Not dic.exists(r.Value) Then
            ReDim w(2)
            For i = 0 To 2: w(i) = r.Offset(, i).Value: Next
            dic.Add r.Value, r.Offset(, 1).Value
        Else
            w = dic(r.Value)
            For i = 1 To 2: w(i) = w(i) + r.Offset(, i).Value: Next
            dic(r.Value) = w
        End If
    End If
Next
x = dic.items
If dic.Count < 1 Then Exit Sub
With Sheets("sheet2").Range("a1")
    For i = LBound(x) To UBound(x)
        .Offset(i).Resize(, UBound(x(i)) + 1) = x(i)
    Next
End With
Set dic = Nothing: Erase x
End Sub

 

[dantb]

Thanks jindon: I have been trying to get it to run but it is hanging on:

Else
w = dic(r.Value)


Any help would be appreciated thanks Dan

 

[jindon]

Can you try to change

Dim dic As Object, w(), x

to

Dim dic As Object, w, x

 

[dantb]

Thanks Jindon: That got me past that line but now hangs on the (Next) in the below line, I Have no idea what to change, Thanks again Dan

For i = 1 To 2: w(i) = w(i) + r.Offset(, i).Value: Next

 

[jindon]

can you watch the variables in the Local Window?
1) open VB editor
2) go to View -> Local Window then run the following code
3) when it poses, you can see the variables in the local window
4) as you hit F8, the code will execute line by line
5) watch the movement of variable w, you can see the element, if you click on + sign

Sub testx() 
Dim dic As Object, w, x 
Dim r As Range 
Set dic = CreateObject("Scripting.Dictionary") 
For Each r In Range("A1", Range("A65536").End(xlUp)) 
    If Not IsEmpty(r) Then 
        If Not dic.exists(r.Value) Then 
            ReDim w(2) 
            For i = 0 To 2: w(i) = r.Offset(, i).Value: Next 
            dic.Add r.Value, r.Offset(, 1).Value 
        Else 
Stop
            w = dic(r.Value) 
            For i = 1 To 2: w(i) = w(i) + r.Offset(, i).Value: Next 
            dic(r.Value) = w 
        End If 
    End If 
Next 
x = dic.items 
If dic.Count < 1 Then Exit Sub 
With Sheets("sheet2").Range("a1") 
    For i = LBound(x) To UBound(x) 
        .Offset(i).Resize(, UBound(x(i)) + 1) = x(i) 
    Next 
End With 
Set dic = Nothing: Erase x 
End Sub

 

[dantb]

Thanks Jindon really useful information, I didn’t know the editor had that feature. I see all the variables and will try to see why it is hanging. Thanks again Dan