Vlookup in database for multiple cells

[fher9728]

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

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:

I want to get Store name and region

the code that I have until now is:

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"

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

 

[mse330]

I have pasted my code in your sample file and it seems to work fine - fher9728.xlsm

This is my sample file - Store ID lookup.xlsb

 

[mse330]

I think I was complicating the code … If we go back to your original code & slightly adjust it like below will work as well

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range, Rg As Range
Set Rg = Sheets("BD CLIENTES").Range("B2").CurrentRegion

If Not Intersect(Target, Range("F:F")) Is Nothing Then
    For Each cell In Target
        If IsEmpty(cell) Then
            cell.Offset(, -4).Resize(, 2) = vbNullString
        Else
            cell.Offset(, -4) = Application.VLookup(cell.Value, Rg.Offset(, 1), 2, 0)
            cell.Offset(, -3) = Application.VLookup(cell.Value, Rg.Offset(, 1), 5, 0)
        End If
    Next
End If

End Sub

 

[Peter_SSs]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Vlookup in database for multiple cells
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[fher9728]

did a cross post, here is the link:
Vlookup in database for multiple cells

 

[mse330]

And this is the file with the vLookUp code posted in post #12

Dropbox

www.dropbox.com

 

[fher9728]

I think I was complicating the code … If we go back to your original code & slightly adjust it like below will work as well

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range, Rg As Range
Set Rg = Sheets("BD CLIENTES").Range("B2").CurrentRegion

If Not Intersect(Target, Range("F:F")) Is Nothing Then
    For Each cell In Target
        If IsEmpty(cell) Then
            cell.Offset(, -4).Resize(, 2) = vbNullString
        Else
            cell.Offset(, -4) = Application.VLookup(cell.Value, Rg.Offset(, 1), 2, 0)
            cell.Offset(, -3) = Application.VLookup(cell.Value, Rg.Offset(, 1), 5, 0)
        End If
    Next
End If

End Sub

Hi, it works perfect!! the only problem that I have now is that I cant delete any row because it gives this error

how can I do in this case?

 

[mse330]

I didn't try that before … Anyway, I made some adjustment to the code to accept row insert/delete as per the below file

Dropbox

www.dropbox.com

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Columns.Count > 15 Then Exit Sub

Dim cell As Range, Rg As Range
Set Rg = Sheets("BD CLIENTES").Range("B2").CurrentRegion

If Not Intersect(Target, Range("F:F")) Is Nothing Then
    For Each cell In Target
        If IsEmpty(cell) Then
            Cells(cell.Row, 2).Resize(, 2) = vbNullString
        Else
            Cells(cell.Row, 2) = Application.VLookup(cell.Value, Rg.Offset(, 1), 2, 0)
            Cells(cell.Row, 3) = Application.VLookup(cell.Value, Rg.Offset(, 1), 5, 0)
        End If
    Next
End If

End Sub

 

[fher9728]

I didn't try that before … Anyway, I made some adjustment to the code to accept row insert/delete as per the below file

Dropbox

www.dropbox.com

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Columns.Count > 15 Then Exit Sub

Dim cell As Range, Rg As Range
Set Rg = Sheets("BD CLIENTES").Range("B2").CurrentRegion

If Not Intersect(Target, Range("F:F")) Is Nothing Then
    For Each cell In Target
        If IsEmpty(cell) Then
            Cells(cell.Row, 2).Resize(, 2) = vbNullString
        Else
            Cells(cell.Row, 2) = Application.VLookup(cell.Value, Rg.Offset(, 1), 2, 0)
            Cells(cell.Row, 3) = Application.VLookup(cell.Value, Rg.Offset(, 1), 5, 0)
        End If
    Next
End If

End Sub

Works perfect, thankyou so much, I appreciate the effort you did to help me!

 

[mse330]

You are welcome … Glad to help & thanks for the feedback

 

[fher9728]

Hi @mse330 , I got a new problem with the new code it doesn't search anything when I do copypaste in the store ID in column F, how can it be solved?