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

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,487
Messages
6,113,938
Members
448,534
Latest member
benefuexx

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
Back
Top