+1 vote
in VBA by Beginner (10 points)

hi, everyone 

i have sheet1 contains data from a2 to g100  and have duplicate data. I need a macro to sum the duplicate data and delete them. At the same time, it should transfer data to sheet2 from a2 to g100.

by Skilled (605 points)
Hello

Can you post sample of the workbook and some of the expected output?
by Beginner (10 points)

 

 

 

 

the result in the second image with macro code 

 

1 Answer

0 votes
by Beginner (19 points)

Put this into a new module.

Public Sub SumDuplicateData()

    Dim Srch As Range
    Sheet2.Range("A2:G100").Value = Empty
    
    For I = 2 To Sheet1.Range("F100").End(xlUp).Row
        Set Srch = Sheet2.Range("F2:F100").Find(Sheet1.Range("F" & I).Value)
        If Srch Is Nothing Then
            For j = 1 To 6
                Sheet2.Range(Cells(Sheet2.Range("F100").End(xlUp).Offset(1, 0).Row, j).Address).Value = Sheet1.Range(Cells(I, j).Address).Value
            Next j
            Sheet2.Range("G" & Sheet2.Range("F100").End(xlUp).Row).Value = Sheet2.Range("F100").End(xlUp).Row - 1
        Else
            For j = 1 To 3
                Sheet2.Range(Cells(Srch.Row, j).Address).Value = Sheet1.Range(Cells(I, j).Address).Value + Sheet2.Range(Cells(Srch.Row, j).Address).Value
            Next j
        End If
    Next I

End Sub

Reply if there are any problems.

by Beginner (10 points)

 

   thanks for your replying runfunke   i waited for long time  but i have error 

  

by Beginner (19 points)
edited by

I'm not exactly sure where the error is happening. My guess is that you don't have Sheet2 created yet. Try this code...

Public Sub SumDuplicateData()

    Dim Srch As Range
    If Not Evaluate("ISREF('Sheet2'!A1)") Then
        Worksheets.Add.Name = "Sheet2"
        Sheet1.Range("A1:G1").Copy
        Worksheets("Sheet2").Range("A1").PasteSpecial
    End If
    Worksheets("Sheet2").Range("A2:G100").Value = Empty
    
    For I = 2 To Sheet1.Range("F100").End(xlUp).Row
        Set Srch = Worksheets("Sheet2").Range("F2:F100").Find(Sheet1.Range("F" & I).Value)
        If Srch Is Nothing Then
            For j = 1 To 6
                Worksheets("Sheet2").Range(Cells(Worksheets("Sheet2").Range("F100").End(xlUp).Offset(1, 0).Row, j).Address).Value = Sheet1.Range(Cells(I, j).Address).Value
            Next j
            Worksheets("Sheet2").Range("G" & Worksheets("Sheet2").Range("F100").End(xlUp).Row).Value = Worksheets("Sheet2").Range("F100").End(xlUp).Row - 1
        Else
            For j = 1 To 3
                Worksheets("Sheet2").Range(Cells(Srch.Row, j).Address).Value = Sheet1.Range(Cells(I, j).Address).Value + Worksheets("Sheet2").Range(Cells(Srch.Row, j).Address).Value
            Next j
        End If
    Next I

End Sub

Otherwise I'm not sure why you are getting an error. I will need more details if this doesn't work.

 

**EDITED

by Beginner (10 points)
IT'S STILL THE SAME PROBLEM  AND  I'M SURE  HAVE  SHEET1,SHEET2
by Beginner (19 points)

Hmmm... I have one more idea since the error you get is too vague and not telling you where the error is occuring. Usually when an error occurs VBA can send you to the line of code causing the problem. Try this in the module now. Otherwise look at the file I am attaching to see what I have done.

Option Explicit

Public Sub SumDuplicateData()

    Dim Srch As Range
    Dim I, J As Integer
    
    If Not Evaluate("ISREF('Sheet2'!A1)") Then
        Worksheets.Add.Name = "Sheet2"
        Worksheets("Sheet1").Range("A1:G1").Copy
        Worksheets("Sheet2").Range("A1").PasteSpecial
    End If
    Worksheets("Sheet2").Range("A2:G100").Value = Empty
    
    For I = 2 To Worksheets("Sheet1").Range("F100").End(xlUp).Row
        Set Srch = Worksheets("Sheet2").Range("F2:F100").Find(Worksheets("Sheet1").Range("F" & I).Value)
        If Srch Is Nothing Then
            For J = 1 To 6
                Worksheets("Sheet2").Range(Cells(Worksheets("Sheet2").Range("F100").End(xlUp).Offset(1, 0).Row, J).Address).Value = Worksheets("Sheet1").Range(Cells(I, J).Address).Value
            Next J
            Worksheets("Sheet2").Range("G" & Worksheets("Sheet2").Range("F100").End(xlUp).Row).Value = Worksheets("Sheet2").Range("F100").End(xlUp).Row - 1
        Else
            For J = 1 To 3
                Worksheets("Sheet2").Range(Cells(Srch.Row, J).Address).Value = Worksheets("Sheet1").Range(Cells(I, J).Address).Value + Worksheets("Sheet2").Range(Cells(Srch.Row, J).Address).Value
            Next J
        End If
    Next I

End Sub

I think the link below is to the file. I'm new at using this forum, so I'm still trying to figure it all out.

https://ask.wellsr.com/?qa=blob&qa_blobid=565429201833400101

by Beginner (10 points)
edited by
yes , the code perfectly work but i hvae  a problem  i ment sum the value not count how many

time  repeated you can see my table 2 in above

it should sum  the columns what contains value

i hope this clear
by Beginner (19 points)
Sorry I don't understand. The code sums up the values of identical things in columns A, B and C. Columns D, E and F are the items. Column G is the count. Do you need column G to be summed also? My file is identical to the tables you posted.
by Beginner (10 points)
yes,  but more explanation

columns e,f,g should sum values  

like this : in sheet1

                                                           a     ,       b         c                d         e          f         g

                                                        1200r20     g580      thi        200     500      700  

                                                         1200r20     g580      thi        200     500      700

 

 

in sheet2 :

                   a     ,       b         c                d         e          f         g

                   1200r20     g580       thi    400   1000   1400

you see that  

sum columns e,f g

i hope this clear
by Beginner (19 points)
you decided to switch the columns from the examples of your original post, which is why there is this problem. I will work on it soon but please be sure that your examples match what you need.
by Beginner (10 points)
you seem misunderstood  what i would  if you check  becarefully you will find out the other comment  is the same what i posted in the above
by Beginner (19 points)

I learned something new, something good for you to know too for the future. Excel Arabic has columns which are reversed from Excel for all other languages. I saw the pictures above and thought column A was on the left to column G on the right. Excel Arabic is reversed with A on the right and G on the left. That was the confusion there. It is not well known, so for the future, when you take pictures of your screen try to include the column and row headings so that any confusion can be avoided. Sorry for that! Here is the updated macro. 

Option Explicit

Public Sub SumDuplicateData()

    Dim Srch, Srch2 As Range
    Dim I, J As Integer
    
    If Not Evaluate("ISREF('Sheet2'!A1)") Then
        Worksheets.Add.Name = "Sheet2"
        Worksheets("Sheet1").Range("A1:G1").Copy
        Worksheets("Sheet2").Range("A1").PasteSpecial
    End If
    Worksheets("Sheet2").Range("A2:G100").Value = Empty
    
    For I = 2 To Worksheets("Sheet1").Range("B100").End(xlUp).Row
        Set Srch = Worksheets("Sheet2").Range("B2:B100").Find(Worksheets("Sheet1").Range("B" & I).Value)
        Set Srch2 = Worksheets("Sheet2").Range("B100").End(xlUp)
        If Srch Is Nothing Then
            For J = 2 To 7
                Worksheets("Sheet2").Range(Cells(Srch2.Offset(1, 0).Row, J).Address).Value = Worksheets("Sheet1").Range(Cells(I, J).Address).Value
            Next J
            Worksheets("Sheet2").Range("A" & Srch2.Row).Offset(1, 0).Value = Srch2.Row - 1
        Else
            For J = 2 To 7
                If IsNumeric(Worksheets("Sheet1").Range(Cells(I, J).Address).Value) Then Worksheets("Sheet2").Range(Cells(Srch.Row, J).Address).Value = Worksheets("Sheet1").Range(Cells(I, J).Address).Value + Worksheets("Sheet2").Range(Cells(Srch.Row, J).Address).Value
            Next J
        End If
    Next I

End Sub

Hope it finally works for you.

by Beginner (10 points)

IT STILL PROBLEM WHEN TRANSFER DATA TO SHEET2   IT BEGINS FROM ROW35 NOT ROW 2 

 

 

by Beginner (10 points)

ok, i try your code with another workbook  it's perfectly work  but i have one thing  in sheet 2 the column  a  in item it doesen't work  numbering correctly 

 

it supposes from 1 not 0 

by Beginner (10 points)

 

ok, i found out  and adjusted the line code  from 

Worksheets("Sheet2").Range("A" & Srch2.Row).Offset(1, 0).Value = Srch2.Row - 1 

to this 

Worksheets("Sheet2").Range("A" & Srch2.Row).Offset(1, 0).Value = Srch2.Row

     honestly , i ppreciate your efforts  and i'm really sorry bacause  

i hvae more question  your code is perfect and work  well done runfunke 

by Beginner (19 points)
+1
You're welcome!

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.

Register

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...