Vlookup in database for multiple cells

F

fher9728

New Member
Joined
Jan 9, 2020
Messages
33
Office Version
  1. 365
Platform
  1. Windows
Hi, its me again,

I have another problem, the thing is that I want to find the name of multiple Stores, I have the store id and I have the Stores Database in another worksheet, the the thing that I want is to run a macro that search me automatically every code that i put in a extensive table(many data that i put here daily), I'll give an example

1585185007512.png


What i want is when i put the code in column F, it appears me automatically the store name in column b , and the region in column c, but I want it in vba because using vlookup in too many cells will blow up my Workbook and need it to remain light, the database of Stores is in another Worksheet this is an example:
1585185406377.png

I want to get Store name and region

the code that I have until now is:
VBA Code: 
Sub buscarnom()



Dim Cl As Range
   
   For Each Cl In Range("f2", Range("F" & Rows.Count).End(xlUp))
      If IsNumeric(Cl.Value) Then
         Cl.Offset(, 10).Value = Application.VLookup(C1.Value, Sheets("BD CLIENTES").Range("C3:D69"), 2, 0)
      Else
         Cl.Offset(, -3).Value = Application.VLookup(C1.Value, Sheets("BD CLIENTES").Range("C3:G69"), 4, 0)
      End If
         Next Cl
      
      End Sub

Second Part,

here I have another table and what I pretend to do is to delete rows with Status "Vencido"
1585185702548.png

But i want to be deleted the entire row, but only the ones with status "vencido" the rows with status vigente not,

Hope you may help me like last time, thank you
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Sort by date Sort by votes
For the first part, the below code uses a "worksheet change evet" which will immediately paste the store name & region in columns B & C after typing/pasting the store ID in column F ... Let me know if that works for you

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Dic As Object, Ar As Variant, cell As Range
Set Dic = CreateObject("scripting.dictionary")
Ar = Sheets("BD CLIENTES").UsedRange.Cells(1, 1).CurrentRegion.Value

For x = LBound(Ar) To UBound(Ar) '--- Assuming your data starts from column A in sheet BD CLIENTES
    If Not Dic.exists(Ar(x, 3)) Then Dic.Add Ar(x, 3), Ar(x, 4) & "|" & Ar(x, 5)
Next

If Not Intersect(Target, Range("F:F")) Is Nothing Then
    For Each cell In Target
        If IsEmpty(cell)  Then
            cell.Offset(, -4) = vbNullString
            cell.Offset(, -3) = vbNullString
        Else
            cell.Offset(, -4) = Split(Dic(cell.Value), "|")(0)
            cell.Offset(, -3) = Split(Dic(cell.Value), "|")(1)
        End If
    Next
End If

End Sub

And the below is for the second part of deleting the rows

VBA Code: 
Sub Delete_vencido()

With ActiveSheet.UsedRange
    .AutoFilter Field:=13, Criteria1:="vencido"
    .Offset(1).SpecialCells(xlVisible).EntireRow.Delete
    .AutoFilter
End With

End Sub
 
Upvote 0
mse330 said:
For the first part, the below code uses a "worksheet change evet" which will immediately paste the store name & region in columns B & C after typing/pasting the store ID in column F ... Let me know if that works for you

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Dic As Object, Ar As Variant, cell As Range
Set Dic = CreateObject("scripting.dictionary")
Ar = Sheets("BD CLIENTES").UsedRange.Cells(1, 1).CurrentRegion.Value

For x = LBound(Ar) To UBound(Ar) '--- Assuming your data starts from column A in sheet BD CLIENTES
    If Not Dic.exists(Ar(x, 3)) Then Dic.Add Ar(x, 3), Ar(x, 4) & "|" & Ar(x, 5)
Next

If Not Intersect(Target, Range("F:F")) Is Nothing Then
    For Each cell In Target
        If IsEmpty(cell)  Then
            cell.Offset(, -4) = vbNullString
            cell.Offset(, -3) = vbNullString
        Else
            cell.Offset(, -4) = Split(Dic(cell.Value), "|")(0)
            cell.Offset(, -3) = Split(Dic(cell.Value), "|")(1)
        End If
    Next
End If

End Sub

And the below is for the second part of deleting the rows

VBA Code: 
Sub Delete_vencido()

With ActiveSheet.UsedRange
    .AutoFilter Field:=13, Criteria1:="vencido"
    .Offset(1).SpecialCells(xlVisible).EntireRow.Delete
    .AutoFilter
End With

End Sub
Click to expand...

hi, I tried to used the code exactly as it was but it does't seem to work, if could you explain me a little, specially this part:
VBA Code: 
For x = LBound(Ar) To UBound(Ar) '--- Assuming your data starts from column A in sheet BD CLIENTES
    If Not Dic.exists(Ar(x, 3)) Then Dic.Add Ar(x, 3), Ar(x, 4) & "|" & Ar(x, 5)
Next

If Not Intersect(Target, Range("F:F")) Is Nothing Then
    For Each cell In Target
        If IsEmpty(cell)  Then
            cell.Offset(, -4) = vbNullString
            cell.Offset(, -3) = vbNullString
        Else
            cell.Offset(, -4) = Split(Dic(cell.Value), "|")(0)
            cell.Offset(, -3) = Split(Dic(cell.Value), "|")(1)

My data in sheet BD Clientes Starts in Column C where there is the Store ID and the Store name is in column D and the region in column G
 
Upvote 0
So there are no data at all in columns A & B in sheet BD CLIENTES ? Also, based on the screen shot provided above, I see that region is in column E but there's another column G where you keep the region ?
 
Upvote 0
mse330 said:
So there are no data at all in columns A & B in sheet BD CLIENTES ? Also, based on the screen shot provided above, I see that region is in column E but there's another column G where you keep the region ?
Click to expand...
In column A there is no data, in Column B have data but I dont need it for searching purpose, the table titles are the next
1585244655171.png


I need Column C data because that is the Store ID Data that is in Column F in the another worksheet, I need Column D because that is the Store name that I need to put in Column B in the another worksheet, and I need Column F, I did a mistake in the last comment, I need column G to extract Region data to put in Column C in the other table, the data range of the table BD Clientes to search it would be C3:F169
 
Upvote 0
Please try the below updated code in a back up file … You need to place the code in the sheet itself not in a sperate module in VBA editor - Just right click on the tab name then click on view code & paste the below code (in the sheet where you need to do the look up not sheet BD CLIENTES)

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Dic As Object, Ar As Variant, cell As Range
Set Dic = CreateObject("scripting.dictionary")
Ar = Sheets("BD CLIENTES").UsedRange.Cells(1, 1).CurrentRegion.Value

For x = LBound(Ar) To UBound(Ar)
    If Not Dic.exists(Ar(x, 2)) Then Dic.Add Ar(x, 2), Ar(x, 3) & "|" & Ar(x, 6)
Next

If Not Intersect(Target, Range("F:F")) Is Nothing Then
    For Each cell In Target
        If IsEmpty(cell) Then
            cell.Offset(, -4) = vbNullString
            cell.Offset(, -3) = vbNullString
        ElseIf InStr(Dic(cell.Value), "|") = 0 Then
            cell.Offset(, -4) = "#N/A"
            cell.Offset(, -3) = "#N/A"
        Else
            cell.Offset(, -4) = Split(Dic(cell.Value), "|")(0)
            cell.Offset(, -3) = Split(Dic(cell.Value), "|")(1)
        End If
    Next
End If

End Sub
 
Upvote 0
mse330 said:
Please try the below updated code in a back up file … You need to place the code in the sheet itself not in a sperate module in VBA editor - Just right click on the tab name then click on view code & paste the below code (in the sheet where you need to do the look up not sheet BD CLIENTES)

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Dic As Object, Ar As Variant, cell As Range
Set Dic = CreateObject("scripting.dictionary")
Ar = Sheets("BD CLIENTES").UsedRange.Cells(1, 1).CurrentRegion.Value

For x = LBound(Ar) To UBound(Ar)
    If Not Dic.exists(Ar(x, 2)) Then Dic.Add Ar(x, 2), Ar(x, 3) & "|" & Ar(x, 6)
Next

If Not Intersect(Target, Range("F:F")) Is Nothing Then
    For Each cell In Target
        If IsEmpty(cell) Then
            cell.Offset(, -4) = vbNullString
            cell.Offset(, -3) = vbNullString
        ElseIf InStr(Dic(cell.Value), "|") = 0 Then
            cell.Offset(, -4) = "#N/A"
            cell.Offset(, -3) = "#N/A"
        Else
            cell.Offset(, -4) = Split(Dic(cell.Value), "|")(0)
            cell.Offset(, -3) = Split(Dic(cell.Value), "|")(1)
        End If
    Next
End If

End Sub
Click to expand...
I did paste in the other sheet not in BD clientes, but it doesnt work :( it doesn't even get me an error, it just remain in blank every cell in column B & D when I put a store ID in column F
 
Upvote 0
This is strange … No errors & doesn't work. Can you share a sample excel file with us here because it is working fine with me in the sample file I prepared.
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question Question
Excel Database and Dependant Lists
Replies
7
Views
274
felixstraube
F
A
  • Solved
Target.address and VLOOKUP with a range of cells
Replies
8
Views
397
RoryA
RoryA
B
  • Question Question
Applying values to a database based on multiple criteria sets
Replies
1
Views
107
Baldred
B
K
  • Question Question
VBA code to reference worksheet second from the end
Replies
1
Views
231
John_w
J
S
  • Solved
Copy hyperlinks from one table column to another. The columns are identical
Replies
2
Views
426
sspatriots
S

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

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