Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

merge duplicates items for two columns contain values

0

Hi

I face  problem  about  values  TOTAL  from two  sheets. so  the  code  merge  duplicates items  based  on  column B   for sheets REPORT1,2    and  sum  the  values  for  columns QTY , TOTAL   with  ignore  column UNIT  PRICE . the  column QTY   sums correctly  but  the  column TOTAL  gives error  values .

the result  in sheet output . I  put  the  right  values  in  column J 

Sub output()
Dim sh As Worksheet, dic As Object, rn As Range, a, n&
Set dic = CreateObject("scripting.dictionary")
For Each sh In ThisWorkbook.Sheets
    If sh.Name <> "output" Then
        For Each rn In Intersect(sh.[a1].CurrentRegion.Resize(, 1).Offset(, 1), sh.[a1].CurrentRegion.Offset(1))
             If dic.exists(rn.Value) Then
                a = dic(rn.Value)
                a(1) = a(1) & "," & Right(rn(1, 2), 3)
                a(6) = a(6) + rn(1, 7).Value
                a(7) = a(7) + rn(1, 9).Value
                If InStr(a(2) & ",", rn(1, 3).Value & ",") = 0 Then a(2) = a(2) & "," & rn(1, 3).Value
                dic(rn.Value) = a
             Else
                ReDim a(9)
                For n = 0 To 8
                    a(n) = rn.Offset(, n).Value
                Next
                a(9) = 1: a(9) = rn(1, 8)
                dic(rn.Value) = a
            End If
        Next
    End If
Next
    With Sheets("output").[a2].Resize(dic.Count)
        .Value = Evaluate("row(1:" & dic.Count & ")")
        .Offset(, 1).Resize(, 8) = Application.Transpose(Application.Transpose(dic.items))
        .Offset(, 3) = Evaluate(Replace("LEFT(#,6)&SUBSTITUTE(#,LEFT(#,6),)", "#", .Offset(, 3).Address))
    End With
End Sub

I  hope to  find somebody  help me 

Answer
Discuss

Answers

0
Selected Answer

Hi Malkal and welcome to the Forum.

Your problem is that you were populating an array with elements a(0) to a(9) but a(7) was UNIT PRICE- unwanted in your output sheet.

In the attached revised file, I have used a(7) to store the TOTAL PRICE  both when the dictionary item is created and when a similar element (BATCH) is added into a key value. I've added some comments and the key changes are in bold below:

Sub output()
Dim sh As Worksheet, dic As Object, rn As Range, a, n&
Set dic = CreateObject("scripting.dictionary")
For Each sh In ThisWorkbook.Sheets
    If sh.Name <> "output" Then
        For Each rn In Intersect(sh.[a1].CurrentRegion.Resize(, 1).Offset(, 1), sh.[a1].CurrentRegion.Offset(1))
             If dic.exists(rn.Value) Then
                a = dic(rn.Value)
                a(1) = a(1) & "," & Right(rn(1, 2), 3)
                a(6) = a(6) + rn(1, 7).Value 'a(6) is stored QTY, rn(1, 7) collects QTY from sh
                a(7) = a(7) + rn(1, 9).Value 'a(7) is stored TOTAL PRICE, rn(1, 9) collects TOTAL PRICE from sh
                If InStr(a(2) & ",", rn(1, 3).Value & ",") = 0 Then a(2) = a(2) & "," & rn(1, 3).Value
                dic(rn.Value) = a
             Else
                ReDim a(8) ' only needs 8
                For n = 0 To 8
                    a(n) = rn.Offset(, n).Value
                    'a(6) gets QTY; 'a(7) gets UNIT PRICE ;a(8) gets TOTAL PRICE
                Next
                'overwrite a(7) to store TOTAL PRICE (and for output)
                a(7) = a(8)
                'a(9) = 1: a(9) = rn(1, 8)
                dic(rn.Value) = a
            End If
        Next
    End If
Next
    With Sheets("output").[a2].Resize(dic.Count)
        .Value = Evaluate("row(1:" & dic.Count & ")")
        .Offset(, 1).Resize(, 8) = Application.Transpose(Application.Transpose(dic.Items))
        .Offset(, 3) = Evaluate(Replace("LEFT(#,6)&SUBSTITUTE(#,LEFT(#,6),)", "#", .Offset(, 3).Address))
    End With
End Sub

This now gives values matching the CORRECT column K in worksheet output (see below).

I also corrected some of your TOTAL PRICE values in worksheets REPORT1 and REPORT2  -see yellow cells there- and corrected the spelling of MANUFACTURE (see red text).

Hope this fixes things for you. Kindly mark this Answer as Selected if so.

Discuss

Discussion

magnificent !
many  thanks  for  your help
Malkal (rep: 22) Aug 1, '22 at 3:09 pm
Glad that worked. Thanks for selecting my Answer, Malkal
John_Ru (rep: 6102) Aug 1, '22 at 3:15 pm
Revised my Answer but only to replace comment "...srore..." with "...store..." (in text and corrected file)
John_Ru (rep: 6102) Aug 1, '22 at 4:12 pm
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login