Vba help

Isabella

Well-known Member
Joined
Nov 7, 2008
Messages
643
Hi,

Is there a macro that will return the abbrev in Col B under the heading "Rec" by looking at the mapping in Col J & K?

Excel Workbook
BCDEFGHIJK
1RecAccountAccountAbbrev
2SMPNCSX.GESBEQGOLDSMP
3SMPNCSX.BENWEBNCSXSMP
4SMPNCSX.GESBESTATSMP
5SMPNCSX.GESSUBSXSMP
6SMPUBSX.SMPSPEMIRXMIR ASIA
7SMPABNA.HOOGOVJPMCSMP
8SMPABNA.HOOGOVDIATSMP
9BNPPINTLBNPP.ABAAOFBNPPBNPPINTL
10NZACLEARAIAU40AMPWNZACLEAR
11NTCONZEXTERNAL
12AMP.FUTURESFUTURES
13AIAU40NZACLEAR
14AIEO40NZACLEAR
15AIFB40NZACLEAR
16AIFG40NZACLEAR
17AIFN40NZACLEAR
18
Sheet2
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
But what is the relationship between cloumn C and j:K? To make a macro you must have a logical criteria to make the selection from
 
Upvote 0
Isabella,


You will have to add the blue items in columns J and K, or cells B7 and B8 will error out with #N/A.


Excel Workbook
BCDEFGHIJK
1RecAccountAccountAbbrev
2SMPNCSX.GESBEQGOLDSMP
3SMPNCSX.BENWEBNCSXSMP
4SMPNCSX.GESBESTATSMP
5SMPNCSX.GESSUBSXSMP
6SMPUBSX.SMPSPEMIRXMIR ASIA
7SMPABNA.HOOGOVJPMCSMP
8SMPABNA.HOOGOVDIATSMP
9BNPPINTLBNPP.ABAAOFBNPPBNPPINTL
10NZACLEARAIAU40AMPWNZACLEAR
11NTCONZEXTERNAL
12AMP.FUTURESFUTURES
13AIAU40NZACLEAR
14AIEO40NZACLEAR
15AIFB40NZACLEAR
16AIFG40NZACLEAR
17AIFN40NZACLEAR
18ABNASMP
19
Sheet2





The formula in cell C2 copied down:

=IF(ISNA(INDEX($K:$K,MATCH($C2,$J:$J,0),0)),INDEX($K:$K,MATCH(LEFT($C2,FIND(".",$C2,1)-1),$J:$J,0),0),INDEX($K:$K,MATCH($C2,$J:$J,0),0))

 
Upvote 0
If i was going to use a formula then i would have used Lookup(9.99etc....) i am after a VBA solution.

Excel Workbook
BCDEFGHIJK
1RecAccountAccountAbbrev
2SMPNCSX.GESBEQGOLDSMP
3SMPNCSX.BENWEBNCSXSMP
4SMPNCSX.GESBESTATSMP
5SMPNCSX.GESSUBSXSMP
6SMPUBSX.SMPSPEMIRXMIR ASIA
7ABN AMROABNA.HOOGOVJPMCSMP
8ABN AMROABNA.HOOGOVDIATSMP
9BNPPINTLBNPP.ABAAOFBNPPBNPPINTL
10NZACLEARAIAU40AMPWNZACLEAR
11NTCONZEXTERNAL
12AMP.FUTURESFUTURES
13AIAU40NZACLEAR
14AIEO40NZACLEAR
15AIFB40NZACLEAR
16AIFG40NZACLEAR
17AIFN40NZACLEAR
18ABNAABN AMRO
19
Sheet2
 
Upvote 0
Try this

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> LookupCodes()<br>    <SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range, AcctFound <SPAN style="color:#00007F">As</SPAN> Range, AccountList <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> s <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, Acct <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> AccountList = Range("J1", Range("J" & Rows.Count).End(xlUp))<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> Range("C2", Range("C" & Rows.Count).End(xlUp))<br>        s = c.Value<br>        <SPAN style="color:#00007F">If</SPAN> Len(s) > 0 <SPAN style="color:#00007F">Then</SPAN><br>            Acct = Split(s, ".")(0)<br>            <SPAN style="color:#00007F">Set</SPAN> AcctFound = AccountList.Find(What:=Acct, _<br>                LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)<br>            <SPAN style="color:#00007F">If</SPAN> AcctFound <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>                c.Offset(, -1).Value = "N/A"<br>            <SPAN style="color:#00007F">Else</SPAN><br>                c.Offset(, -1).Value = AcctFound.Offset(, 1).Value<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> c<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
 
Last edited:
Upvote 0
Of course you could also do it by having vba just apply the formula you have. :)

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> LookupCodes2()<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> Range("B2:B" & Range("C" & Rows.Count).End(xlUp).Row)<br>        .Formula = "=LOOKUP(9.99999999999999E+307,SEARCH($J$2:$J$18,C2),$K$2:$K$18)"<br>        .Value = .Value<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

Note, however, that the formula approach could result in an incorrect value if it was possible to have, say, "NCSX.ABNA" in column C.
 
Last edited:
Upvote 0
Isabella,


Sample data before the macro:


Excel Workbook
BCDEFGHIJK
1RecAccountAccountAbbrev
2NCSX.GESBEQGOLDSMP
3NCSX.BENWEBNCSXSMP
4NCSX.GESBESTATSMP
5NCSX.GESSUBSXSMP
6UBSX.SMPSPEMIRXMIR ASIA
7ABNA.HOOGOVJPMCSMP
8ABNA.HOOGOVDIATSMP
9BNPP.ABAAOFBNPPBNPPINTL
10AIAU40AMPWNZACLEAR
11IsabellaNTCONZEXTERNAL
12ABNA.HOOGOVAMP.FUTURESFUTURES
13AIAU40NZACLEAR
14AIEO40NZACLEAR
15AIFB40NZACLEAR
16AIFG40NZACLEAR
17AIFN40NZACLEAR
18ABNAABN AMRO
19
Sheet2





After the macro:


Excel Workbook
BCDEFGHIJK
1RecAccountAccountAbbrev
2SMPNCSX.GESBEQGOLDSMP
3SMPNCSX.BENWEBNCSXSMP
4SMPNCSX.GESBESTATSMP
5SMPNCSX.GESSUBSXSMP
6SMPUBSX.SMPSPEMIRXMIR ASIA
7ABN AMROABNA.HOOGOVJPMCSMP
8ABN AMROABNA.HOOGOVDIATSMP
9BNPPINTLBNPP.ABAAOFBNPPBNPPINTL
10NZACLEARAIAU40AMPWNZACLEAR
11IsabellaNTCONZEXTERNAL
12ABN AMROABNA.HOOGOVAMP.FUTURESFUTURES
13AIAU40NZACLEAR
14AIEO40NZACLEAR
15AIFB40NZACLEAR
16AIFG40NZACLEAR
17AIFN40NZACLEAR
18ABNAABN AMRO
19
Sheet2





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


Code:
Option Explicit
Sub FindRec()
'hiker95, 04/09/2011
' http://www.mrexcel.com/forum/showthread.php?t=542342
Dim c As Range, LR As Long, rng1 As Range, rng2 As Range, H
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 10).End(xlUp).Row
Set rng1 = Range("J2:J" & LR)
Set rng2 = Range("K2:K" & LR)
For Each c In Range("C2", Range("C" & Rows.Count).End(xlUp))
  On Error Resume Next
  H = Application.Lookup(9.99999999999999E+307, Application.Search(rng1, c), rng2)
  On Error GoTo 0
  If Not IsError(H) Then
    c.Offset(, -1) = H
  End If
Next c
Application.ScreenUpdating = True
End Sub


Then run the FindRec macro.
 
Upvote 0
Hi peter that works but how do i get rid of the N/A in col b?

Excel Workbook
BCDEFGHIJK
1RecAccountAccountAbbrev
2SMPNCSX.GESBEQGOLDSMP
3SMPNCSX.BENWEBNCSXSMP
4SMPNCSX.GESBESTATSMP
5SMPNCSX.GESSUBSXSMP
6SMPUBSX.SMPSPEMIRXMIR ASIA
7SMPABNA.HOOGOVJPMCSMP
8SMPABNA.HOOGOVDIATSMP
9BNPPINTLBNPP.ABAAOFBNPPBNPPINTL
10NZACLEARAIAU40AMPWNZACLEAR
11N/ANTCONZEXTERNAL
12N/AAMP.FUTURESFUTURES
13N/AAIAU40NZACLEAR
14N/AAIEO40NZACLEAR
15N/AAIFB40NZACLEAR
16N/AAIFG40NZACLEAR
17N/AAIFN40NZACLEAR
18N/AABNASMP
Sheet2







Try this


Sub LookupCodes()
Dim c As Range, AcctFound As Range, AccountList As Range
Dim s As String, Acct As String

Set AccountList = Range("J1", Range("J" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
For Each c In Range("C2", Range("C" & Rows.Count).End(xlUp))
s = c.Value
If Len(s) > 0 Then
Acct = Split(s, ".")(0)
Set AcctFound = AccountList.Find(What:=Acct, _
LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If AcctFound Is Nothing Then
c.Offset(, -1).Value = "N/A"
Else
c.Offset(, -1).Value = AcctFound.Offset(, 1).Value
End If
End If
Next c
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,548
Messages
6,179,451
Members
452,915
Latest member
hannnahheileen

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