VBA: find all matches of one list in each cell of another list and create combined rank

F

fxrexcel

New Member
Joined
Aug 11, 2018
Messages
18
I have the following problem with VBA:

I have a list of names of persons with a rank (either "1" or "2", see below) and I want to search their number of occurrences in another table and add up the ranks.

Person Data:

[TABLE="width: 200"]
<tbody>[TR]
[TD]Person[/TD]
[TD]Rank[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]K[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]P[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]U[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]T[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]...[/TD]
[TD]...[/TD]
[/TR]
</tbody>[/TABLE]


Company Data:

  • red is what needs to be written in Col "Combined Rank")
  • In my Company Data, the names of the persons data are sometimes followed by random brackets and/or spaces and then brackets

[TABLE="width: 400"]
<tbody>[TR]
[TD]Company[/TD]
[TD]Persons[/TD]
[TD]Combined Rank[/TD]
[/TR]
[TR]
[TD]C1[/TD]
[TD]A(), B (..)[/TD]
[TD]3 [= Rank(A)+Rank(B)=1 + 2][/TD]
[/TR]
[TR]
[TD]C2[/TD]
[TD]K[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]C3[/TD]
[TD]K [--], P, A, T[/TD]
[TD]5 [=2 + 1 + 1 + 1] [/TD]
[/TR]
[TR]
[TD]C4[/TD]
[TD]Q[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]C5[/TD]
[TD]-[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]C6[/TD]
[TD]A, U{ff}[/TD]
[TD]3 [=1 + 2][/TD]
[/TR]
[TR]
[TD]...[/TD]
[TD]...[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Thanks a lot for your help.
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Sort by date Sort by votes
I don't know if you actually need VBA, but you can do that with just a formula:

ABCDEFG
PersonRankCompanyPersonsCombined Rank
2AC1A(), B (..)
BC2K
KC3K [--], P, A, T
PC4Q
UC5
TC6A, U{ff}

<tbody>
[TD="align: center"]1[/TD]

[TD="align: right"][/TD]

[TD="align: right"][/TD]

[TD="align: right"]1[/TD]
[TD="align: right"][/TD]

[TD="align: right"]3[/TD]
[TD="align: right"][/TD]

[TD="align: center"]3[/TD]

[TD="align: right"]2[/TD]
[TD="align: right"][/TD]

[TD="align: right"]2[/TD]
[TD="align: right"][/TD]

[TD="align: center"]4[/TD]

[TD="align: right"]2[/TD]
[TD="align: right"][/TD]

[TD="align: right"]5[/TD]
[TD="align: right"][/TD]

[TD="align: center"]5[/TD]

[TD="align: right"]1[/TD]
[TD="align: right"][/TD]

[TD="align: right"]0[/TD]
[TD="align: right"][/TD]

[TD="align: center"]6[/TD]

[TD="align: right"]2[/TD]

[TD="align: right"]-[/TD]
[TD="align: right"]0[/TD]

[TD="align: center"]7[/TD]

[TD="align: right"]1[/TD]
[TD="align: right"][/TD]

[TD="align: right"]3[/TD]
[TD="align: right"][/TD]

</tbody>
Sheet7​

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Array Formulas[TABLE="width: 100%"]
<tbody>[TR]
[TH]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
[TR]
[TH]F2[/TH]
[TD="align: left"]{=SUM(IF(ISNUMBER(FIND($A$2:$A$7,E2)),$B$2:$B$7))}[/TD]
[/TR]
</tbody>[/TABLE]
Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}.
Note: Do not try and enter the {} manually yourself[/TD]
[/TR]
</tbody>[/TABLE]



Let us know if this works, or if you need VBA.
 
Last edited:
Upvote 0
Try this:-
"Person" Table starts "A2"
"Company" Table starts "D2"
Results in column "F".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG16Aug19
[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] num [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", 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
   .Item(Dn.Value) = Dn.Offset(, 1)
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("E2", Range("E" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] n = 1 To Len(Dn.Value)
        [COLOR="Navy"]If[/COLOR] Dn.Characters(n, 1).Text >= Chr(65) And Dn.Characters(n, 1).Text <= Chr(90) [COLOR="Navy"]Then[/COLOR]
            num = num + .Item(Dn.Characters(n, 1).Text)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
Dn.Offset(, 1).Value = num: num = 0
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick,

Thanks for that. The names are actual names and not just "A","B,"C", etc.

How do you change the code for that?

Thanks a lot for your help!
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG18Aug50
im Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] num [COLOR="Navy"]As[/COLOR] Double, sp [COLOR="Navy"]As[/COLOR] Variant, nstr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", 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
   .Item(Dn.Value) = Dn.Offset(, 1)
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("E2", Range("E" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] n = 1 To Len(Dn.Value)
        [COLOR="Navy"]If[/COLOR] UCase(Dn.Characters(n, 1).Text) >= Chr(65) And UCase(Dn.Characters(n, 1).Text) <= Chr(90) [COLOR="Navy"]Then[/COLOR]
            nstr = nstr & Dn.Characters(n, 1).Text
        [COLOR="Navy"]Else[/COLOR]
         nstr = nstr & ","
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
    sp = Split(nstr, ",")
    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(sp)
       [COLOR="Navy"]If[/COLOR] .exists(sp(n)) [COLOR="Navy"]Then[/COLOR]
        num = num + .Item(sp(n))
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
Dn.Offset(, 1).Value = num: num = 0: nstr = ""
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

Emerlin
  • Question Question
Combine rank values and auto-sort with formula and limited/no helper columns
Replies
8
Views
263
Peter_SSs
Peter_SSs
B
  • Solved
Formula or VBA to track pro-rated attendance hours
Replies
8
Views
345
bh24524
B
gtd526
  • Solved
vba selecting entire range from offset
Replies
5
Views
351
Tetra201
Tetra201
S
  • Solved
Rank a list
Replies
8
Views
677
Fluff
Fluff
K
  • Question Question
Create list of cells from one column that matches one criteria and separate based on another cell criteria
Replies
2
Views
510
Kay10
K

Forum statistics

Threads
1,223,911
Messages
6,175,327
Members
452,635
Latest member
laura12345

Share this page

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