VBA Copying and sorting data Method

[pong]

I have a bunch of data like this
Fruit type No.
Apple 2
Orange 4
Peach 5
Guava 1
Apple 5
Apple 5
Orange 5
Apple 5
Orange 5


There are 4 types of Fruits up there .But there are many times of entries
How can I write a programe to see how many different names up there and end up as follows on the other sheet

Apple 17
Orange 19
Peach 5
Guava 1

 

[MickG]

Try this:- Results start "C1"

[COLOR="Navy"]Sub[/COLOR] MG14Aug05
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[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(, 2)
        [COLOR="Navy"]Else[/COLOR]
            .Item(Dn.Value) = .Item(Dn.Value) + Dn(, 2)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR]
Range("C1").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items))
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Peter_SSs]

Excel's built-in Pivot Table feature is ideal for that sort of analysis.

 

[pong]

thank you very much for both of you

Mick: I will try this and see how it works. Thanks a lot

Peter: I know pivot table can sort the data. But I actually have more formulas needed to do on the number column. I just simplified the situation and connect to the other program
Still, thanks a lot. I have a lot to learn from you guys

 

[Peter_SSs]

Peter: I know pivot table can sort the data. But I actually have more formulas needed to do on the number column. I just simplified the situation ...

Well, if it is just the unique list you are looking for, then I would use another of Excel's built-in features - Advanced Filter.

If the original data was on a sheet called 'Data' and you wanted the list on a sheet called 'Summary', then try something like this:

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Macro1()<br>    <SPAN style="color:#00007F">With</SPAN> Sheets("Data")<br>        .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).AdvancedFilter _<br>            Action:=xlFilterCopy, _<br>            CopyToRange:=Sheets("Summary").Range("A1"), Unique:=<SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>