I want the vlookup vba code

[roykana]

Dear All,

I ask for help for the vlookup VBA code, I hereby attach the documents, I ask for a VBA code in column H (PERIOD vba),
Column I (CATEGORY vba), Column J (NAME vba) or what I marked in yellow. I want the results in column H, I, J
to be equal to in columns E, F, G. so that the results have the same status in columns k, L, M.
this is my link : MULTI VLOOKUP IN VBA - R1.xlsm
file

Option Explicit


Sub multivlookup()
    Application.ScreenUpdating = False

    ' sort DB sheet on col A
  With Sheets("DB")
      .Range("C1:F61").Sort Key1:=.Range("C1"), order1:=xlAscending, Header:=xlYes
   End With
   With Range(Cells(2, 8), Cells(2, 8).End(xlDown))
       .FormulaR1C1 = "=IF(VLOOKUP([@DATE],dbperiod,1,true)=[@DATE],VLOOKUP([@DATE],dbperiod,4),"""")"
       .Value = .Value
   End With
    Application.ScreenUpdating = True
End Sub

Thanks
roykana

 

[roykana]

Dear all master,
can anyone help me for the vba code?

Thanks
Roykana

 

[Osvaldo Palmeiro]

Hi. Try this:

Sub multivlookupV2()
 Application.ScreenUpdating = False
 With Sheets("DB")
  .Range("C1:F61").Sort Key1:=.Range("C1"), order1:=xlAscending, Header:=xlYes
 End With
 With ActiveSheet.ListObjects("Table10").DataBodyRange
  .Columns(8).Resize(, 3).ClearContents
  .Columns(8).FormulaR1C1 = "=IFERROR(VLOOKUP([@DATE],dbperiod,4,0),"""")"
  .Columns(9).FormulaR1C1 = "=IFERROR(VLOOKUP([@ID],dbuser,3,0),"""")"
  .Columns(10).FormulaR1C1 = "=IFERROR(VLOOKUP([@ID],dbuser,2,0),"""")"
  .Columns(8).Resize(, 3).Copy
  .Columns(8).PasteSpecial Paste:=xlPasteValues
 End With
 Application.CutCopyMode = False: [H2].Select
End Sub

Also, you should add a zero at the end of the formula that is in E2, as you did in F:G, so it would be like this ~~~> =IFERROR(VLOOKUP([@DATE],dbperiod,4,0),"")
In addition, I think that the formula in G2 should have parameter 2 instead of 4.
Current formula ~~~> =IF(E2="","",IFERROR(VLOOKUP([@ID],dbuser,4,0),""))
It should be ~~~> =IF(E2="","",IFERROR(VLOOKUP([@ID],dbuser,2,0),""))

 

[roykana]

Hi. Try this:

Sub multivlookupV2()
Application.ScreenUpdating = False
With Sheets("DB")
  .Range("C1:F61").Sort Key1:=.Range("C1"), order1:=xlAscending, Header:=xlYes
End With
With ActiveSheet.ListObjects("Table10").DataBodyRange
  .Columns(8).Resize(, 3).ClearContents
  .Columns(8).FormulaR1C1 = "=IFERROR(VLOOKUP([@DATE],dbperiod,4,0),"""")"
  .Columns(9).FormulaR1C1 = "=IFERROR(VLOOKUP([@ID],dbuser,3,0),"""")"
  .Columns(10).FormulaR1C1 = "=IFERROR(VLOOKUP([@ID],dbuser,2,0),"""")"
  .Columns(8).Resize(, 3).Copy
  .Columns(8).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False: [H2].Select
End Sub

Also, you should add a zero at the end of the formula that is in E2, as you did in F:G, so it would be like this ~~~> =IFERROR(VLOOKUP([@DATE],dbperiod,4,0),"")
In addition, I think that the formula in G2 should have parameter 2 instead of 4.
Current formula ~~~> =IF(E2="","",IFERROR(VLOOKUP([@ID],dbuser,4,0),""))
It should be ~~~> =IF(E2="","",IFERROR(VLOOKUP([@ID],dbuser,2,0),""))

dear sir,
thank you for the vba code provided. actually for column 10 I want to get the location data so I just name the column name wrong.
ok I'll just follow you into the name. For the formula in column 8 I can't use this formula ~~~> = IFERROR (VLOOKUP ([@ DATE], dbperiod, 4,0), "")
because it will only contain the correct date so I have to change it without 0. I have also fixed the code a little to be perfect. I have a little question if I want to set the table name how to add the code vba?

thanks
roykana

Option Explicit
Sub multivlookupV2()
 Application.ScreenUpdating = False
 With Sheets("DB")
  .Range("C1:F61").Sort Key1:=.Range("C1"), order1:=xlAscending, Header:=xlYes
 End With
 With ActiveSheet.ListObjects("Table10").DataBodyRange
  .Columns(8).Resize(, 3).ClearContents
  .Columns(8).FormulaR1C1 = "=IFERROR(VLOOKUP([@DATE],dbperiod,4),"""")"
  .Columns(9).FormulaR1C1 = "=IF(RC[-1]="""","""",IFERROR(VLOOKUP([@ID],dbuser,3,0),""""))"
  .Columns(10).FormulaR1C1 = "=IF(RC[-2]="""","""",IFERROR(VLOOKUP([@ID],dbuser,2,0),""""))"
  .Columns(8).Resize(, 3).Copy
  .Columns(8).PasteSpecial Paste:=xlPasteValues
 End With
 Application.CutCopyMode = False: [H2].Select
End Sub

 

[roykana]

Dear sir,

thank you for the vba code provided.

thanks
roykana

 

[Osvaldo Palmeiro]

Hi, Roykana.
If I understood correctly it seems that you don't want the Excel Table name to be hard coded, is it ? If so, then, try the code below.
If the Excel Table could be in another location than A1, then you could replace [A1] by ActiveCell, select any cell on the Excel Table and run the code.

Sub multivlookupV4()
Dim objTable As String
On Error GoTo getout 'if A1 doesn't belong to any Excel Table, then code will end execution
If [A1].ListObject <> "" Then
On Error GoTo 0 'restart Error handler
objTable = [A1].ListObject.Name
End If
Application.ScreenUpdating = False
With Sheets("DB")
.Range("C1:F61").Sort Key1:=.Range("C1"), order1:=xlAscending, Header:=xlYes
End With
With ActiveSheet.ListObjects(objTable).DataBodyRange
.Columns(8).Resize(, 3).ClearContents
.Columns(8).FormulaR1C1 = "=IFERROR(VLOOKUP([@DATE],dbperiod,4),"""")"
.Columns(9).FormulaR1C1 = "=IF(RC[-1]="""","""",IFERROR(VLOOKUP([@ID],dbuser,3,0),""""))"
.Columns(10).FormulaR1C1 = "=IF(RC[-2]="""","""",IFERROR(VLOOKUP([@ID],dbuser,2,0),""""))"
.Columns(8).Resize(, 3).Copy
.Columns(8).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False: [H2].Select
getout:
End Sub

 

[roykana]

Hi, Roykana.
If I understood correctly it seems that you don't want the Excel Table name to be hard coded, is it ? If so, then, try the code below.
If the Excel Table could be in another location than A1, then you could replace [A1] by ActiveCell, select any cell on the Excel Table and run the code.

Sub multivlookupV4()
Dim objTable As String
On Error GoTo getout 'if A1 doesn't belong to any Excel Table, then code will end execution
If [A1].ListObject <> "" Then
On Error GoTo 0 'restart Error handler
objTable = [A1].ListObject.Name
End If
Application.ScreenUpdating = False
With Sheets("DB")
.Range("C1:F61").Sort Key1:=.Range("C1"), order1:=xlAscending, Header:=xlYes
End With
With ActiveSheet.ListObjects(objTable).DataBodyRange
.Columns(8).Resize(, 3).ClearContents
.Columns(8).FormulaR1C1 = "=IFERROR(VLOOKUP([@DATE],dbperiod,4),"""")"
.Columns(9).FormulaR1C1 = "=IF(RC[-1]="""","""",IFERROR(VLOOKUP([@ID],dbuser,3,0),""""))"
.Columns(10).FormulaR1C1 = "=IF(RC[-2]="""","""",IFERROR(VLOOKUP([@ID],dbuser,2,0),""""))"
.Columns(8).Resize(, 3).Copy
.Columns(8).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False: [H2].Select
getout:
End Sub

Dear Mr. Osvaldo Palmeiro,

Thank you very much. the code you provide works perfectly.

Thanks
roykana