help to correct error code duplicate data

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
10,225
Office Version
2007
Platform
Windows
Try the following macro. It works according to the example you set, where the data on sheet1 starts in cell A1.

SHEET1:
a b c d e f g
ITEM BRAND TYPE ORIGIN IMPORT EXPORT BALANCE
1 1200R20 G580 THI 200 50 150
Code:
Sub SumDuplicates()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim r As Range, f As Range, cell As String
    
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    For i = 2 To sh1.Range("B" & Rows.Count).End(xlUp).Row
        Set r = sh2.Range("B2", sh2.Range("B" & Rows.Count).End(xlUp))
        Set f = r.Find(sh1.Cells(i, "B").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not f Is Nothing Then
            cell = f.Address
            Do
                If sh2.Cells(f.Row, "C").Value = sh1.Cells(i, "C").Value And _
                   sh2.Cells(f.Row, "D").Value = sh1.Cells(i, "D").Value Then
                    sh2.Cells(f.Row, "E").Value = sh2.Cells(f.Row, "E").Value + sh1.Cells(i, "E").Value
                    sh2.Cells(f.Row, "F").Value = sh2.Cells(f.Row, "F").Value + sh1.Cells(i, "F").Value
                    sh2.Cells(f.Row, "G").Value = sh2.Cells(f.Row, "G").Value + sh1.Cells(i, "G").Value
                    Exit Do
                End If
                Set f = r.FindNext(f)
            Loop While Not f Is Nothing And f.Address <> cell
        Else
            sh2.Range("A" & Rows.Count).End(xlUp)(2).Resize(1, 7).Value = sh1.Range("A" & i).Resize(1, 7).Value
        End If
    Next
    MsgBox "Done"
End Sub
 

Some videos you may like

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

abdelfattah

Board Regular
Joined
May 3, 2019
Messages
193
Try the following macro. It works according to the example you set, where the data on sheet1 starts in cell A1.



Code:
Sub SumDuplicates()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim r As Range, f As Range, cell As String
    
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    For i = 2 To sh1.Range("B" & Rows.Count).End(xlUp).Row
        Set r = sh2.Range("B2", sh2.Range("B" & Rows.Count).End(xlUp))
        Set f = r.Find(sh1.Cells(i, "B").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not f Is Nothing Then
            cell = f.Address
            Do
                If sh2.Cells(f.Row, "C").Value = sh1.Cells(i, "C").Value And _
                   sh2.Cells(f.Row, "D").Value = sh1.Cells(i, "D").Value Then
                    sh2.Cells(f.Row, "E").Value = sh2.Cells(f.Row, "E").Value + sh1.Cells(i, "E").Value
                    sh2.Cells(f.Row, "F").Value = sh2.Cells(f.Row, "F").Value + sh1.Cells(i, "F").Value
                    sh2.Cells(f.Row, "G").Value = sh2.Cells(f.Row, "G").Value + sh1.Cells(i, "G").Value
                    Exit Do
                End If
                Set f = r.FindNext(f)
            Loop While Not f Is Nothing And f.Address <> cell
        Else
            sh2.Range("A" & Rows.Count).End(xlUp)(2).Resize(1, 7).Value = sh1.Range("A" & i).Resize(1, 7).Value
        End If
    Next
    MsgBox "Done"
End Sub

thank's so much DanteAmor it's perfectly works code
 

Watch MrExcel Video

Forum statistics

Threads
1,090,053
Messages
5,412,073
Members
403,411
Latest member
Michlovsky

This Week's Hot Topics

Top