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

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
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
286
Peter_SSs
Peter_SSs
B
  • Solved
Formula or VBA to track pro-rated attendance hours
Replies
8
Views
387
bh24524
B
P
  • Question Question
Lambda or VBA to solve the pairs webinar problem!!!
Replies
0
Views
129
Phantom1
P
Emka
  • Question Question
Web Scrap on Chrome via VBA
Replies
0
Views
155
Emka
Emka
gtd526
  • Solved
vba selecting entire range from offset
Replies
5
Views
359
Tetra201
Tetra201

Forum statistics

Threads
1,224,825
Messages
6,181,189
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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