Macro code vba exel sum dublicate data and delete

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

5 replies

Post the code that you have worked on, as so we are careful to not duplicate what you have.

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

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
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
Sheets.add after:=Activesheet

give it a try
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
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.
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.
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?
Should be in the totals and moved
you'r maco it completely works but remain one thing the totals and removed
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


'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
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
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!
Blocked Profile
Jul 17, 2019 at 10:17 PM
I hope you really try to learn what is going on!
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)
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!!!
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.
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!
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!!!!



Sheet 2 after run
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
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!

Didn't find the answer you are looking for?

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


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.
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
a b c d e
peas,,10 0
six,,10 0
banana,,10 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.