Macro for Vlookup based on a Criteria

U

user2021

New Member
Joined
Mar 10, 2021
Messages
12
Office Version
  1. 365
Platform
  1. Windows
Need help to get my code corrected. I need the Column C values onto my "working sheet Column B" based on the string value that is "column B in entity sheet". vlookup value would be the entity ID in column A.
sheet.png



VBA Code: 
Set sht = ActiveWorkbook.Worksheets("working sheet")
Set sht1 = ActiveWorkbook.Worksheets("entity sheet")

LR = sht.UsedRange.Rows.Count

With sht
For i = 2 To LR
If InStr(sht1.Range("B" & i).Value, "WS") Then
sht.Range("B" & i).Value = (Application.VLookup(.Range("A" & i).Value, Worksheets("entity sheet").Range("A2:C5000"), 3, False))
End If
Next i
End With


EDIT: Fixed VBA code
 
Last edited by a moderator:
Sort by date Sort by votes
user2021 said:
am not getting the expected result. on running the code, the expected result column - "source entity id - wss" is blank.
Click to expand...
I'm sorry. I put the sheet name wrongly. The sheets' name were switch. I wrongly put ws1 as working sheet and ws2 as entity sheet. Just need to switch the reference.
VBA Code: 
Sub LookUpCriteria()

Dim eRow As Long
Dim cell As Range, rngData As Range
Dim Element As Variant, dData  As Object
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("entity sheet")
Set ws2 = ActiveWorkbook.Worksheets("working sheet")

eRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
Set rngData = ws1.Range("A2", "A" & eRow)
Set dData = CreateObject("Scripting.Dictionary")

For Each cell In rngData
    If Left(cell.Offset(0, 1), 2) = "WS" Then
        dData.Add cell.Value2, cell.Offset(0, 2).Value2
    End If
Next

For Each cell In rngData
    For Each Element In dData
        ws2.Range("A" & cell.Row) = cell.Value2
        If cell.Value2 = Element Then
            ws2.Range("B" & cell.Row) = dData(Element)
        End If
    Next
Next

End Sub
 
Upvote 0

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Zot said:
I'm sorry. I put the sheet name wrongly. The sheets' name were switch. I wrongly put ws1 as working sheet and ws2 as entity sheet. Just need to switch the reference.
VBA Code: 
Sub LookUpCriteria()

Dim eRow As Long
Dim cell As Range, rngData As Range
Dim Element As Variant, dData  As Object
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("entity sheet")
Set ws2 = ActiveWorkbook.Worksheets("working sheet")

eRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
Set rngData = ws1.Range("A2", "A" & eRow)
Set dData = CreateObject("Scripting.Dictionary")

For Each cell In rngData
    If Left(cell.Offset(0, 1), 2) = "WS" Then
        dData.Add cell.Value2, cell.Offset(0, 2).Value2
    End If
Next

For Each cell In rngData
    For Each Element In dData
        ws2.Range("A" & cell.Row) = cell.Value2
        If cell.Value2 = Element Then
            ws2.Range("B" & cell.Row) = dData(Element)
        End If
    Next
Next

End Sub
Click to expand...
I am getting the desired result, but I have a question. I removed data from row 17 onwards in my working sheet. the macro is not stopping with row 16, rather it pulls in all the data after row 16 from the entity sheet.
 
Upvote 0
user2021 said:
I am getting the desired result, but I have a question. I removed data from row 17 onwards in my working sheet. the macro is not stopping with row 16, rather it pulls in all the data after row 16 from the entity sheet.
Click to expand...
What do you meant by removed from row 17 onward? It means no more data after row 17 for me :) If you removed just 1 row then it will continue running until last data.

However, even though the code gave correct answer, it is not really correct in term of execution. I rewrote the code so that it will not double-looping unnecessarily. It will also skip the blank row (unlike previous code). Try this and let me know the result.

VBA Code: 
Sub LookUpCriteria()

Dim n As Long, eRow As Long
Dim cell As Range, rngData As Range
Dim dData  As Object
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("entity sheet")
Set ws2 = ActiveWorkbook.Worksheets("working sheet")

Application.ScreenUpdating = False
eRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
Set rngData = ws1.Range("A2", "A" & eRow)
Set dData = CreateObject("Scripting.Dictionary")

For Each cell In rngData
    If Left(cell.Offset(0, 1), 2) = "WS" Then
        dData.Add cell.Value2, cell.Offset(0, 2).Value2
    End If
Next
n = 1
For Each cell In rngData
    If Not Len(cell.Value2) = 0 Then
        n = n + 1
        ws2.Range("A" & n) = cell.Value2
        If dData.exists(cell.Value2) Then
            ws2.Range("B" & n) = dData(cell.Value2)
        End If
    End If
Next
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Zot said:
What do you meant by removed from row 17 onward? It means no more data after row 17 for me :) If you removed just 1 row then it will continue running until last data.

However, even though the code gave correct answer, it is not really correct in term of execution. I rewrote the code so that it will not double-looping unnecessarily. It will also skip the blank row (unlike previous code). Try this and let me know the result.

VBA Code: 
Sub LookUpCriteria()

Dim n As Long, eRow As Long
Dim cell As Range, rngData As Range
Dim dData  As Object
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("entity sheet")
Set ws2 = ActiveWorkbook.Worksheets("working sheet")

Application.ScreenUpdating = False
eRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
Set rngData = ws1.Range("A2", "A" & eRow)
Set dData = CreateObject("Scripting.Dictionary")

For Each cell In rngData
    If Left(cell.Offset(0, 1), 2) = "WS" Then
        dData.Add cell.Value2, cell.Offset(0, 2).Value2
    End If
Next
n = 1
For Each cell In rngData
    If Not Len(cell.Value2) = 0 Then
        n = n + 1
        ws2.Range("A" & n) = cell.Value2
        If dData.exists(cell.Value2) Then
            ws2.Range("B" & n) = dData(cell.Value2)
        End If
    End If
Next
Application.ScreenUpdating = True

End Sub
Click to expand...
Thanks for your time. But this code is also giving me the same result. it does'nt stop with last row in the working sheet, but brings in all the other data from the entity sheet. i have just given a sample of my report that i work. actual rows in my file is 30000+ rows. so i should not add on any extra data to my working sheet.
 
Upvote 0
user2021 said:
Thanks for your time. But this code is also giving me the same result. it does'nt stop with last row in the working sheet, but brings in all the other data from the entity sheet. i have just given a sample of my report that i work. actual rows in my file is 30000+ rows. so i should not add on any extra data to my working sheet.
Click to expand...
Now I think we are on different page :)

Now I think we are on different page. Let me try to understand again.

You have 2 sheets:
1) entity sheet
2) working sheet

On entity sheet you have these data
Entity.xlsm
ABC
1entity idsource idsource entity
2HR0001GOP1200
3HR0002WSSWSS 1201
4HR0003GOP1201
5HR0004WSS-TWSST 1202
6HR0005GOP1202
7HR0006GOP1203
8HR0007WSS-SWSSS 1203
9HR0008GOP1204
10HR0009GOP1205
11HR00010GOP1206
12HR00011WSS-RWSSR 1204
13HR00012WSS-TWSST 1205
14HR00013WSS-SWSSS 1206
15HR00014GOP1207
16HR00015WSS-SWSSS 1207
17HR0006WSS-SWSSS 1208
18HR0007GOP1208
19HR0008WSS-TWSST 1209
20HR0009WSS-SWSSS 1210
entity sheet


I presumed that the working sheet is a blank sheet to begin with

What you want was:
I need the Column C values onto my "working sheet Column B" based on the string value that is "column B in entity sheet". vlookup value would be the entity ID in column A.

What I did was:
1) Copy column A (entity id) in entity sheet to working sheet column A
2) Find the matching entity id in entity sheet and check if column B (source id) in entity sheet starts with "WS"
3) If that is true, copy column c (source entity) in entity sheet to column B in working sheet or leave blank if none

The code will continue run through all the list in entity sheet until last data in the sheet. If there is blank rows, it will skip that row and continue until the end. The result I get is the same like you wanted

Entity.xlsm
AB
2HR0001
3HR0002WSS 1201
4HR0003
5HR0004WSST 1202
6HR0005
7HR0006WSSS 1208
8HR0007WSSS 1203
9HR0008WSST 1209
10HR0009WSSS 1210
11HR00010
12HR00011WSSR 1204
13HR00012WSST 1205
14HR00013WSSS 1206
15HR00014
16HR00015WSSS 1207
17HR0006WSSS 1208
18HR0007WSSS 1203
19HR0008WSST 1209
20HR0009WSSS 1210
working sheet


If I delete row 17 (leaving blank row), I get this result

Entity.xlsm
AB
2HR0001
3HR0002WSS 1201
4HR0003
5HR0004WSST 1202
6HR0005
7HR0006
8HR0007WSSS 1203
9HR0008WSST 1209
10HR0009WSSS 1210
11HR00010
12HR00011WSSR 1204
13HR00012WSST 1205
14HR00013WSSS 1206
15HR00014
16HR00015WSSS 1207
17HR0007WSSS 1203
18HR0008WSST 1209
19HR0009WSSS 1210
working sheet


So, I do not really understand what problem you are explaining. Maybe I understood wrong what you've wanted.
 
Upvote 0
Zot said:
Now I think we are on different page :)

Now I think we are on different page. Let me try to understand again.

You have 2 sheets:
1) entity sheet
2) working sheet

On entity sheet you have these data
Entity.xlsm
ABC
1entity idsource idsource entity
2HR0001GOP1200
3HR0002WSSWSS 1201
4HR0003GOP1201
5HR0004WSS-TWSST 1202
6HR0005GOP1202
7HR0006GOP1203
8HR0007WSS-SWSSS 1203
9HR0008GOP1204
10HR0009GOP1205
11HR00010GOP1206
12HR00011WSS-RWSSR 1204
13HR00012WSS-TWSST 1205
14HR00013WSS-SWSSS 1206
15HR00014GOP1207
16HR00015WSS-SWSSS 1207
17HR0006WSS-SWSSS 1208
18HR0007GOP1208
19HR0008WSS-TWSST 1209
20HR0009WSS-SWSSS 1210
entity sheet


I presumed that the working sheet is a blank sheet to begin with

What you want was:
I need the Column C values onto my "working sheet Column B" based on the string value that is "column B in entity sheet". vlookup value would be the entity ID in column A.

What I did was:
1) Copy column A (entity id) in entity sheet to working sheet column A
2) Find the matching entity id in entity sheet and check if column B (source id) in entity sheet starts with "WS"
3) If that is true, copy column c (source entity) in entity sheet to column B in working sheet or leave blank if none

The code will continue run through all the list in entity sheet until last data in the sheet. If there is blank rows, it will skip that row and continue until the end. The result I get is the same like you wanted

Entity.xlsm
AB
2HR0001
3HR0002WSS 1201
4HR0003
5HR0004WSST 1202
6HR0005
7HR0006WSSS 1208
8HR0007WSSS 1203
9HR0008WSST 1209
10HR0009WSSS 1210
11HR00010
12HR00011WSSR 1204
13HR00012WSST 1205
14HR00013WSSS 1206
15HR00014
16HR00015WSSS 1207
17HR0006WSSS 1208
18HR0007WSSS 1203
19HR0008WSST 1209
20HR0009WSSS 1210
working sheet


If I delete row 17 (leaving blank row), I get this result

Entity.xlsm
AB
2HR0001
3HR0002WSS 1201
4HR0003
5HR0004WSST 1202
6HR0005
7HR0006
8HR0007WSSS 1203
9HR0008WSST 1209
10HR0009WSSS 1210
11HR00010
12HR00011WSSR 1204
13HR00012WSST 1205
14HR00013WSSS 1206
15HR00014
16HR00015WSSS 1207
17HR0007WSSS 1203
18HR0008WSST 1209
19HR0009WSSS 1210
working sheet


So, I do not really understand what problem you are explaining. Maybe I understood wrong what you've wanted.
Click to expand...
Hi, ok let me explain. The working sheet is not blank. It will have the entity IDs. Basically i am trying to a do a simple vlookup in my working sheet based on the entity id to get the source entity IDs from the entity sheet. but the vlookup returns the first available value in the source entity id. therefore i want a vlookup to pick up the source entity id only where the source ID that starts with WS.

You have 2 sheets: YES
1) entity sheet
2) working sheet

What I did was:
1) Copy column A (entity id) in entity sheet to working sheet column A - THIS IS NOT REQUIRED. ONLY FOR EXISTING ENTITY ID I NEED SOURCE ENTITY ID BASED ON SOURCE ID.
2) Find the matching entity id in entity sheet and check if column B (source id) in entity sheet starts with "WS"
3) If that is true, copy column c (source entity) in entity sheet to column B in working sheet or leave blank if none

The code will continue run through all the list in entity sheet until last data in the sheet. If there is blank rows, it will skip that row and continue until the end. The result I get is the same like you wanted - THE CODE HAS TO RUN FOR MY OWRKING SHEET AND ENTITY SHEET IS MY SOURCE DATA.

Hope this is clear
 
Last edited:
Upvote 0
user2021 said:
Hi, ok let me explain. The working sheet is not blank. It will have the entity IDs. Basically i am trying to a do a simple vlookup in my working sheet based on the entity id to get the source entity IDs from the entity sheet. but the vlookup returns the first available value in the source entity id. therefore i want a vlookup to pick up the source entity id only where the source ID that starts with WS.

You have 2 sheets: YES
1) entity sheet
2) working sheet

What I did was:
1) Copy column A (entity id) in entity sheet to working sheet column A - THIS IS NOT REQUIRED. ONLY FOR EXISTING ENTITY ID I NEED SOURCE ENTITY ID BASED ON SOURCE ID.
2) Find the matching entity id in entity sheet and check if column B (source id) in entity sheet starts with "WS"
3) If that is true, copy column c (source entity) in entity sheet to column B in working sheet or leave blank if none

The code will continue run through all the list in entity sheet until last data in the sheet. If there is blank rows, it will skip that row and continue until the end. The result I get is the same like you wanted - THE CODE HAS TO RUN FOR MY OWRKING SHEET AND ENTITY SHEET IS MY SOURCE DATA.

Hope this is clear
Click to expand...
Just like I suspected. From very beginning, you have never provided data on working sheet. So, I started on wrong footing :oops:

Your entity sheet has more data than sample provided, right?
Can you use XL2BB to copy and paste sample working sheet or at least copy paste the sample data. It is easier for me instead of retyping the data. This should not be difficult but I wanted to try the code before posting
 
Upvote 0
Without testing, try this code:
VBA Code: 
Sub LookUpCriteria()

Dim eRow As Long
Dim cell As Range, rngEntity As Range, rngData As Range
Dim dData  As Object
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("entity sheet")
Set ws2 = ActiveWorkbook.Worksheets("working sheet")

Application.ScreenUpdating = False
Set dData = CreateObject("Scripting.Dictionary")

eRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
Set rngEntity = ws1.Range("A2", "A" & eRow)
For Each cell In rngEntity
    If Left(cell.Offset(0, 1), 2) = "WS" Then
        dData.Add cell.Value2, cell.Offset(0, 2).Value2
    End If
Next

eRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
Set rngData = ws2.Range("A2", "A" & eRow)
For Each cell In rngData
    If Not Len(cell.Value2) = 0 Then
        If dData.exists(cell.Value2) Then
            cell.Offset(0, 1) = dData(cell.Value2)
        End If
    End If
Next
Application.ScreenUpdating = True

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
reproduce code to make fast ,currently too slow and crash
Replies
6
Views
139
Peter_SSs
Peter_SSs
CJG19
  • Solved
Dynamic Table Hide Rows
Replies
2
Views
121
CJG19
CJG19
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
193
Coco1
C
F
  • Question
VBA Code to record changes/logs modification needed?
Replies
0
Views
51
FGaxha
F
SandsB
  • Question
Sorting when a column or 2 is empty
Replies
1
Views
150
DanteAmor
DanteAmor

Forum statistics

Threads
1,214,523
Messages
6,120,039
Members
448,940
Latest member
mdusw

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