help to correct error  code duplicate data
Page 2 of 2 FirstFirst 12
Results 11 to 14 of 14

Thread: help to correct error code duplicate data

  1. #11
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,732
    Post Thanks / Like
    Mentioned
    65 Post(s)
    Tagged
    14 Thread(s)

    Default Re: help to correct error code duplicate data

    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
    Regards Dante Amor

  2. #12
    New Member
    Join Date
    May 2019
    Posts
    49
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: help to correct error code duplicate data

    Quote Originally Posted by DanteAmor View Post
    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

  3. #13
    New Member
    Join Date
    May 2019
    Posts
    49
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: help to correct error code duplicate data

    thanks for everybody try to help me

  4. #14
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,732
    Post Thanks / Like
    Mentioned
    65 Post(s)
    Tagged
    14 Thread(s)

    Default Re: help to correct error code duplicate data

    Quote Originally Posted by abdelfattah View Post
    thank's so much DanteAmor it's perfectly works code

    I'm glad to help you. Thanks for the feedback.
    Regards Dante Amor

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •