Previous Topic Next Topic

Macro code vba exel sum dublicate data and delete

Closed
abdelfatah - Jul 16, 2019 at 11:44 AM
 Blocked Profile - Jul 19, 2019 at 12:17 PM
hi, everybody
i need help code vba exel i have data in sheet1 begening from cells a2:g100 many data are dublicateed
i would the sum dublicate and delet also the result shows in sheet2 from a2:g100 becarfull not dublicate
Related:

5 responses

Answer 1 / 5
Blocked Profile
Updated on Jul 16, 2019 at 12:28 PM
Post the code that you have worked on, as so we are careful to not duplicate what you have.

0
abdelfatah
Jul 16, 2019 at 12:36 PM
this is my code 
Sub main()

With ActiveSheet '<== change "Fruit Stock" as per your actual sheet name

    With Range("a1:G10")
        Set r = .Resize(.Cells(.Rows.Count, .Columns.Count).End(xlUp).Row)

        With r

            .Copy
            With .Offset(, .Columns.Count + 1)
                .PasteSpecial xlPasteValues ' copy value and formats
                .Columns(1).Offset(1).Resize(.Rows.Count - 1, 1).FormulaR1C1 = "=SUMIF(C" & r.Column & ",RC" & r.Column & ",C[-" & .Columns.Count + 1 & "])"
                .Value = .Value
                .RemoveDuplicates 1, xlYes
            End With

        End With

End With
End With
End Sub
0
Blocked Profile
Jul 16, 2019 at 01:31 PM
I just recorded this macro:

Activesheet.range ("$ g $1:$ g $10").removeduplicates Columns:=1, Header:==xlNo
Range ("g1:g10").select
Selection.copy
Sheets.add after:=Activesheet
Activesheet.paste

give it a try
0
Answer 2 / 5
abdelfatah
Jul 16, 2019 at 02:14 PM
you don't seem understand me what i ment sum the dublicated data in sheet1 then delete the dublicated data and transfer data to sheet2
for more explanation :
sheet1: a b c d e f g
item brand type origin purchase sales balance
1 1200R20 G580 THI 200 100 100
2 315/80R22.5 R184 JAP 500 50 450
3 1200R20 G580 THI 800 0 800
4 315/80R22.5 R184 JAP 1 100 50 1050
5 1200R20 G580 THI 1400 100 1300
the result to be in sheet2 :
a b c d e f g
item brand type origin purchase sales balance
1 1200R20 G580 THI 2400 200 2200
2 315/80R22.5 R184 JAP 600 100 500
it supposed transfer the data with formula from sheet1 to 2
0
Blocked Profile
Jul 16, 2019 at 03:18 PM
No I understand!! I will help you, I will not write your code. The point of my post was show you that ypu perform a macro to perform any task that YOU WISH, then edit it to scale it to what ever model YOU need. You will not learn by cut and paste.
0
Blocked Profile
Jul 16, 2019 at 04:01 PM
You can always use:
Worksheetfunction.match (cells (somerow, somecolumn), range ("a1:a" & lastrowofcount), 0)
To trap the duplicates. Place them into an array. , cut the array, and paste it.
0
Blocked Profile
Jul 16, 2019 at 04:07 PM
Also, is the first set of a data that is duplicated count as a duplicate, or not. Should it be in the totals and moved, or everyother occurance after the first?
0
abdelfatah
Jul 16, 2019 at 04:45 PM
Should be in the totals and moved
0
abdelfatah
Jul 16, 2019 at 04:54 PM
you'r maco it completely works but remain one thing the totals and removed
0
Answer 3 / 5
Blocked Profile
Updated on Jul 18, 2019 at 09:23 AM
Alright, I am cleaning up some code, and will post it here for your review. Give me a couple of Hours! 

Dim item(), itemrow(), itemcostA(), itemCostB(), itemCostC(), itemdup()
Dim arraycnt

Sub sbFindDuplicatesInColumn()
    Dim lastrow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long
    
    lastrow = findlastrow("Sheet1")
    arraycnt = 0
       
    For iCntr = 1 To lastrow
    
        arraycnt = arraycnt + 1
        MsgBox (arraycnt & " the counter")
            ReDim Preserve item(arraycnt)
            ReDim Preserve itemrow(arraycnt)
            ReDim Preserve itemcostA(arraycnt)
            ReDim Preserve itemCostB(arraycnt)
            ReDim Preserve itemCostC(arraycnt)
            ReDim Preserve itemdup(arraycnt)
            
            itemdup(arraycnt) = 0
            
                            If Cells(iCntr, 1) <> "" Then
                                matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastrow), 0)
                                If iCntr <> matchFoundIndex Then
                                    'Cells(iCntr, 2) = "Duplicate " & iCntr
                                    getlen = UBound(item) - LBound(item) + 1
                                   ' MsgBox (getlen & " is the size of the array")
                                    For t = 1 To getlen - 1
                                        If Cells(arraycnt, 1).Value = item(t) Then
                                        MsgBox ("this item would be added into " & item(t))
                                        itemdup(t) = 1
                                        Cells(arraycnt, 2).Value = "combined"
                                        itemcostA(t) = itemcostA(t) + Cells(arraycnt, 3).Value
                                        itemCostB(t) = itemCostB(t) + Cells(arraycnt, 4).Value
                                        itemCostC(t) = itemCostC(t) + Cells(arraycnt, 5).Value
                                        'MsgBox ("new total is: " & itemcostA(t) & " for array " & item(t))
                                        
                                  
                                        End If
                                    
                                    'itemdup(arraycnt) = 0
                                    
                                    Next
                            Else
                                    
                                    'add the item into the array
                                    
                                    itemrow(arraycnt) = iCntr
                                    item(arraycnt) = Cells(iCntr, 1).Value
                                    itemcostA(arraycnt) = Cells(iCntr, 3).Value
                                    itemCostB(arraycnt) = Cells(iCntr, 4).Value
                                    itemCostC(arraycnt) = Cells(iCntr, 5).Value
                                    'itemdup(arraycnt) = 0
                                    
                                    'MsgBox (item(arraycnt) & " is set for arraycnt " & arraycnt)
                            End If
                    End If
    Next
            ThisWorkbook.Worksheets("Sheet2").Cells(1, 1).Value = "A"
            ThisWorkbook.Worksheets("Sheet2").Cells(1, 3).Value = "C"
        For Xcntr = 1 To lastrow
        
        'MsgBox (itemdup(Xcntr) & " is set for " & item(Xcntr))
             If itemdup(Xcntr) = 1 Then
             'Cells(Xcntr, 2).Value = "*"
                 
                 thisistherow = findlastrow("Sheet2") + 1
                 
                MsgBox ("this is the row: " & thisistherow)
                 
                 MsgBox ("moving  it to: " & thisistherow )
               
                 ThisWorkbook.Worksheets("Sheet2").Cells(thisistherow, 1).Value = item(Xcntr)
                 ThisWorkbook.Worksheets("Sheet2").Cells(thisistherow, 3).Value = itemcostA(Xcntr)
                           
             End If
        Next
End Sub

Function findlastrow(whatsheet)
findlastrow = ThisWorkbook.Worksheets(whatsheet).Cells(Rows.Count, 1).End(xlUp).Row
End Function


And no, we have not deleted any duplicates, yet!!!!

Please do not post and tell me how it does not work, as it does, figure it out!
0
Blocked Profile
Jul 17, 2019 at 10:17 PM
I hope you really try to learn what is going on!
0
abdelfatah
Jul 18, 2019 at 02:52 AM
i appreciate your efforts i try understanding your code but, you know i'm not programmer i would learn this language vba anyway i have error when i press f5 show me this error "variable no defined" about this line
ReDim Preserve item(arraycnt)
0
Blocked Profile
Updated on Jul 18, 2019 at 08:40 AM
The sheet that you want to look for the duplicates on has to the active sheet. I did not place any error checking on this.

Perhaps, if you are not a programmer, then perform the analyst role, and manually perform the task through functions and spreadsheet design!! This can be performed by built in excel functions!!!
0
Blocked Profile
Updated on Jul 18, 2019 at 07:44 AM
Are your sheets named sheet1 and sheet2? As I said, I am not going to produce a turn key solution. If I need to comment the code for you to understand, I will.
0
Blocked Profile
Jul 18, 2019 at 07:45 AM
And yes, I know this is archaic code structure, but I wanted to expand the steps and not make it all one liners!
0
Answer 4 / 5
Blocked Profile
Updated on Jul 18, 2019 at 04:15 PM
Look, I just opened a new workbook, set up two columns in A and C. Placed words in A and in C placed values next to them. Opened the developer tab. Inserted a new module. Came here, cut the code from above, pasted it into the module, and it ran. I can only encourage you to delete what ever module you have had, and start a new one, with only this code in it, as I NEVER HAD OPTION EXPLICIT in my code, so by you saying that you removed it, makes me wonder what else are you using?

Make certain Sheet1 is the active sheet when running the code. That is the only way that I can produce your error, is if sheet 2 has focus when it is run!!!!

Prior


After


Sheet 2 after run
0
abdelfatah
Jul 19, 2019 at 07:11 AM
ok i change my workbook the code does work but not completely
i put data in sheet 1 in cell a,b from cells 1 to 5 are repeated when i run code the data in sheet1 are gone the cells are empty and in sheet2 show letters a ,c, d ,e in column a,c,d,e and the data show but the value is 0 i fill data like you to columns
0
Blocked Profile
Jul 19, 2019 at 07:16 AM
First thing, I do not know what to say. I have ran it on three different machines, and they all run without exception.

Second thing, you stated: " i fill data like you to columns", but then previously you had remarked "i put data in sheet 1 in cell a,b", WHICH IS CLEARLY WRONG!

I have no confidence you are deploying, or using this correctly. Once again, no issues here!
0

Didn't find the answer you are looking for?

Ask a question
Answer 5 / 5
Blocked Profile
Jul 19, 2019 at 09:24 AM
Ok try this..... 


one,,10				
two,,10								
three,,10								
orange,,10								
Five,,10								
seven,,10								
peas,,10								
here,,10								
four,,10								
there,,10								
five,,10								
six,,10								
banana,,10								
peas,,10								
six,,10								
banana,,10


Take the above data set, cut and paste it into notepad. Now save it as sample.CSV (you will need to change the file type to all in order to save it as CSV!). Now, open your workbook with the code on it. Delete everything in SHEET1. Under the data tab, select GET DATA FROM TEXT/CSV. Find SAMPLE.CSV and select it. Now, under load, there is another option of load to, select cell A1 of Sheet1.

That should set the data up as expected to run.
0
abdelfatah
Jul 19, 2019 at 12:12 PM
here i do your steps the processing code changed a Little not more when i run the code in sheet1 stay the non repeating but the problem still continue in sheet2 it shows a,c,d,e in column a,c,d,e like this
columns:
a b c d e
A C D E
peas,,10 0
six,,10 0
banana,,10 0
0
Blocked Profile
Jul 19, 2019 at 12:17 PM
Ok, so that code isn't formatting the result correctly? That is your job. You are the presentation, I am the engine!

Do you know where to change the headers in the code? I remarked it where to change them to whatever you wish.
0

Similar discussions

Unlock code
Priya -
HelpiOS -

1 response
lava hard reset & factory reset
AVAY -
Pnr -

2 responses
Tetris unlock the code samsung
Mohit -
HelpiOS -

1 response
unlock codes for nokia
AlbertoAmaru -
Anonymous User -

1 response