VB Macro Remove Duplicates

[Cugedhion]

Hi,

I need your help.

My task here is to create a VB Macro. I have my codes here, I just copied the column from another sheet

Worksheets("Report").Select
Sheets("Detailed").Columns(2).Copy Destination:=Sheets("Report").Columns(1)
Sheets("Detailed").Columns(9).Copy Destination:=Sheets("Report").Columns(2)
Sheets("Detailed").Columns(10).Copy Destination:=Sheets("Report").Columns(3)
Sheets("Detailed").Columns(11).Copy Destination:=Sheets("Report").Columns(4)


This is my Data.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Gabby[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]Gabby[/TD]
[TD]0[/TD]
[TD]3[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]Sonny[/TD]
[TD]0[/TD]
[TD]4[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]Sonny[/TD]
[TD]0[/TD]
[TD]1[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]Sonny[/TD]
[TD]0[/TD]
[TD]1[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]Zeny[/TD]
[TD]0[/TD]
[TD]2[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]Zeny[/TD]
[TD]2[/TD]
[TD]5[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]Pat[/TD]
[TD]0[/TD]
[TD]4[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]Pat[/TD]
[TD]0[/TD]
[TD]3[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]AND SO ON[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

This is my desired output..

I have to get the sum of all the columns 2, 3, and 4 based on the column 1, and then I have to divide Column 3 and Column 4 (COL3/COL4) and place it to the 5th Column

[TABLE="width: 500"]
<tbody>[TR]
[TD]Gabby[/TD]
[TD]1[/TD]
[TD]5[/TD]
[TD]7[/TD]
[TD]0.71[/TD]
[/TR]
[TR]
[TD]Sonny[/TD]
[TD]0[/TD]
[TD]6[/TD]
[TD]13[/TD]
[TD]0.46[/TD]
[/TR]
[TR]
[TD]Zeny[/TD]
[TD]2[/TD]
[TD]7[/TD]
[TD]5[/TD]
[TD]1.4[/TD]
[/TR]
[TR]
[TD]Pat[/TD]
[TD]0[/TD]
[TD]7[/TD]
[TD]6[/TD]
[TD]1.67[/TD]
[/TR]
</tbody>[/TABLE]


How will I come up with my desired output?

 

[DLB20720]

You could accomplish this with a Pivot Table a lot easier than writing VBA, IMHO at least. You need column headers but a Pivot Table would SUM all data for each person, per column. The run a formula in adjacent cells.

 

[Cugedhion]

Yes, it is possible if I use Pivot tables. Well, this is my homework: create A VB Macro given this data. I will study the codes whoever has a kind-heart to provide me the solution.

 

[MickG]

Assuming you data starts in "A1", Here is an answer.
This code will remove the unwanted rows and provide the sum in column "E"
You may need to do a bit more homework before you can declare , This was all my own Work !!!!

[COLOR=Navy]Sub[/COLOR] MG26Jan57
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] nRng [COLOR=Navy]As[/COLOR] Range, K [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
        .Add Dn.Value, Dn
    [COLOR=Navy]Else[/COLOR]
        [COLOR=Navy]For[/COLOR] n = 1 To 3
            .Item(Dn.Value).Offset(, n) = .Item(Dn.Value).Offset(, n) + Dn.Offset(, n)
        [COLOR=Navy]Next[/COLOR] n
        [COLOR=Navy]If[/COLOR] nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]Set[/COLOR] nRng = Dn
        [COLOR=Navy]Else[/COLOR]
            [COLOR=Navy]Set[/COLOR] nRng = Union(nRng, Dn)
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]If[/COLOR] Not nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
        .Item(K).Offset(, 4) = Format(.Item(K).Offset(, 2) / .Item(K).Offset(, 3), "0.00")
    [COLOR=Navy]Next[/COLOR] K
nRng.EntireRow.Delete
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[vds1]

You may try this,

Sub Test_Macro()


Dim LastRow As Long


Worksheets("Report").Select
Sheets("Detailed").Columns(2).Copy Destination:=Sheets("Report").Columns(1)
Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
LastRow = Range("A" & Rows.Count).End(xlUp).row


Range("B2:B" & LastRow).Formula = "=SUMIF(Detailed!B:B,A2,Detailed!I:I)"
Range("C2:C" & LastRow).Formula = "=SUMIF(Detailed!B:B,A2,Detailed!J:J)"
Range("D2:D" & LastRow).Formula = "=SUMIF(Detailed!B:B,A2,Detailed!K:K)"
Range("E1").Value = "Your_col_name"
Range("E2:E" & LastRow).Formula = "=C2/D2"


Range("E2:E" & LastRow).NumberFormat = "0.00"
With Range("B2:E" & LastRow)
    .Copy
    .PasteSpecial xlPasteValues
End With
Range("A1").Select
Application.CutCopyMode = False


End Sub

---------------------------------------
How to start ?
1. Copy the below code
2. Open the workbook in which you want to add the code
3. Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
4. Choose Insert | Module
5. Where the cursor is flashing, choose Edit | Paste

How to run the code?
1. On the Excel Ribbon, click the View tab
2. At the far right, click Macros
3. Select a macro in the list, and click the Run button

 

[Cugedhion]

Hi MickG, Many Thanks for providing your code. I'm still studying on how you create your code.

 

[Cugedhion]

Hi vds1, Thanks for Providing your code, It works. . Many Thanks

 

[vds1]

Hi vds1, Thanks for Providing your code, It works. . Many Thanks

Your welcome. Do come back if you need more help. Have a good day.