Counting number of times a number will appear in a Pasted column, some cells having multiple numbers in them using VBA

daltendavis

New Member
Joined
Jun 26, 2018
Messages
37
For example I would paste in A1:
995
950-993
*995-118
118
790-118

I want it to return on a separate sheet:

995 2
950 1
993 1
118 3
790 1

Right now I have it coming back as exactly what is pasted in the cell and cannot figure it out what so ever.:confused:

Thank you for your help.

EDIT:
Also forgot to mention, like the *995 in the example some entries have an astrix in front of them it is split with another store. Thanks again
 
Last edited by a moderator:

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this for results on sheet 2.
Code:
[COLOR="Navy"]Sub[/COLOR] MG26Jun52
[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] Sp [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
Dn.Value = IIf(Left(Dn.Value, 1) = "*", Mid(Dn.Value, 2), Dn.Value)
    Sp = Split(Dn.Value, "-")
        [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
            .Item(Sp(n)) = .Item(Sp(n)) + 1
        [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR]
Sheets("Sheet2").Range("A1").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items))
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Sorry Typo at end of code
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG26Jun28
[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] Sp [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
Dn.Value = IIf(Left(Dn.Value, 1) = "*", Mid(Dn.Value, 2), Dn.Value)
    Sp = Split(Dn.Value, "-")
        [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
            .Item(Sp(n)) = .Item(Sp(n)) + 1
        [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR]
Sheets("Sheet2").Range("A1").Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]


Also try this for your other thread:-
Results on sheet2.
Code:
[COLOR="Navy"]Sub[/COLOR] MG26Jun30
[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] Sp [COLOR="Navy"]As[/COLOR] Variant, Q [COLOR="Navy"]As[/COLOR] Variant, K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[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
Dn.Value = IIf(Left(Dn.Value, 1) = "*", Mid(Dn.Value, 2), Dn.Value)
    Sp = Split(Dn.Value, "-")
        [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
            [COLOR="Navy"]If[/COLOR] Not .exists(Sp(n)) [COLOR="Navy"]Then[/COLOR]
            .Add Sp(n), Array(UBound(Sp) + 1, 1)
            [COLOR="Navy"]Else[/COLOR]
                Q = .Item(Sp(n))
                    Q(1) = Q(1) + 1
                .Item(Sp(n)) = Q
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR]
ReDim Ray(1 To .Count * 10, 1 To 2)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
        c = c + 1
        Ray(c, 1) = K
        Ray(c, 2) = Format(Val(.Item(K)(1)) / Val(.Item(K)(0)), "0.00")
    [COLOR="Navy"]Next[/COLOR] K
Sheets("Sheet2").Range("A1").Resize(c, 2) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

daltendavis

New Member
Joined
Jun 26, 2018
Messages
37

ADVERTISEMENT

Thank youuuuu both work you are the bomb
 

daltendavis

New Member
Joined
Jun 26, 2018
Messages
37
Hey Mick some of the numbers start with a 0 in front of them, for example 043, 014, 015, etc. Would the values returning on sheet 2 be able to have the 0 infront of them as well? this is an example of something I would be pasting while utilizing the second VBA code on this thread:

CLM CHEP
CLM CHEP
703 - 551
925 - 909
OFF
OFF
OFF
975 - 153
705 - 879
1 Pal WC Meats - 849 - 531
461 - 502
597 - 683
OFF
OFF
021 - 099
093 - 386
841 - 048
OFF
118 - 938
102 - 407
167 - 900
657 - 699
OFF
014 - 019
OFF
132 - 073
*022 - 136 - 164
077
508
WEST ROCK
409 - 888
719
933 - 983
395
OFF
015 - 790
049 - 043
829 - 022
850 - 788
058 - 912

Thanks again so much for the help
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG26Jun58
[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] Sp [COLOR="Navy"]As[/COLOR] Variant, Q [COLOR="Navy"]As[/COLOR] Variant, K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[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
Dn.Value = IIf(Left(Dn.Value, 1) = "*", Mid(Dn.Value, 2), Dn.Value)
    Sp = Split(Dn.Value, "-")
        [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
            [COLOR="Navy"]If[/COLOR] Not .exists(Sp(n)) [COLOR="Navy"]Then[/COLOR]
                .Add Sp(n), Array(UBound(Sp) + 1, 1)
            [COLOR="Navy"]Else[/COLOR]
                Q = .Item(Sp(n))
                    Q(1) = Q(1) + 1
                .Item(Sp(n)) = Q
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR]
ReDim Ray(1 To .Count * 10, 1 To 2) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
        c = c + 1
        Ray(c, 1) = Trim(K)
        Ray(c, 2) = Format(Val(.Item(K)(1)) / Val(.Item(K)(0)), "0.00")
    [COLOR="Navy"]Next[/COLOR] K
Sheets("Sheet2").Range("A1").Resize(c, 2) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

Forum statistics

Threads
1,136,333
Messages
5,675,171
Members
419,552
Latest member
jsanjur

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top