VBA Vlookup

Joseph111

New Member
Joined
Jan 10, 2021
Messages
19
Office Version
  1. 2016
Platform
  1. Windows
Please for help. Why it`s not works?

VBA Code:
Sub Check_equpment1_click()
Worksheets("Production_program").Activate
Dim ans1 As Integer
ans1 = MsgBox("Ñìÿíà íà àñîðòèìåíò ïî äàòà/Check Job change by Date", vbQuestion + vbYesNo + vbDefaultButton2, "Equipment")
If ans1 = vbYes Then
On Error GoTo MyErrorHandler1:
Dim Date1 As String
Dim Range1 As Range
Date1 = InputBox("Âúâåäè äàòà/Enter date:", Title:="Equipment by date")
For Each Range1 In Sheet1.Range("B13:B500")
If Date1 = Range1.Value Then
Det = "Êîä íà Àñîðòèìåíòà (Article code):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 7, False)
Det = Det & vbNewLine & "Èìå íà Àñîðòèìåíòà (Article name):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 8, False)
Det = Det & vbNewLine & "Ëèíèÿ (Line):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 9, False)
Det = Det & vbNewLine & "Ìàøèíà (Machine):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 10, False)
Det = Det & vbNewLine & "Äîëíè Çâåçäè (Lower starwheels): " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 11, False)
Det = Det & vbNewLine & "Ìÿñòî (Place):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 12, False)
Det = Det & vbNewLine & "Ãîðíè Çâåçäè (Upper starwheels):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 13, False)
Det = Det & vbNewLine & "Ìÿñòî (Place):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 14, False)
Det = Det & vbNewLine & "Øíåê (Infeed screw):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 15, False)
Det = Det & vbNewLine & "Êàëèáúð (Plug gauge):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 16, False)
Det = Det & vbNewLine & "Èçõîäÿùè ðåëñè - äîëíè (outfeed guides lower):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 17, False)
Det = Det & vbNewLine & "Ìÿñòî (Place):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 18, False)
Det = Det & vbNewLine & "Èçõîäÿùè ðåëñè - ãîðíè (outfeed guides upper):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 19, False)
Det = Det & vbNewLine & "Ìÿñòî (Place):  " & Application.WorksheetFunction.VLookup(Date1, Sheet1.Range("B13:U500"), 20, False)
MsgBox "" & vbNewLine & Det
Exit For
End If
Next
MyErrorHandler1:
If Err.Number = 1004 Then
End If
End If
End Sub
 

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
405
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi, Can you please share what range B13:B500 contains in sheet1 ? What is the data type ? (integer/ Date/ String)

In comparison, If Date1 = Range1.Value both should be of same type.

Thanks,
Saurabh
 

Joseph111

New Member
Joined
Jan 10, 2021
Messages
19
Office Version
  1. 2016
Platform
  1. Windows
Hello,

Thanks for the reply, Column B is equal to column Z. I attached picture to see

In column Z, we just fill the date manually (for example 15.1.2021) and we receive this date in column B. Is it possible this is the problem?

Thanks in advance
 

Attachments

  • example.jpg
    example.jpg
    110.2 KB · Views: 54

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
405
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi,

It seems that column B and Z contains text type data;.

Are you entering the date in same format in Input box (15.1.2021) ?

Thanks,
Saurabh
 

aRandomHelper

Board Regular
Joined
Jan 14, 2021
Messages
188
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

You are already looping and looking for a match on the date, and you're grabbing the data only when the dates match, why still use Vlookup to search for the date?

VBA Code:
For Each Range1 In Sheet1.Range("Z13:Z500")   '<-- you can loop on column Z as well
If Date1 = Range1.Value Then
Det = "Êîä íà Àñîðòèìåíòà (Article code):  " & Cells(Range1.Row, "K").Value  '<-- use Range1.Row to get the matching row number since you're already looping
Det = Det & vbNewLine & "Èìå íà Àñîðòèìåíòà (Article name):  " & Cells(Range1.Row, "L").Value

etc..
 

Joseph111

New Member
Joined
Jan 10, 2021
Messages
19
Office Version
  1. 2016
Platform
  1. Windows
Hi,

It seems that column B and Z contains text type data;.

Are you entering the date in same format in Input box (15.1.2021) ?

Thanks,
Saurabh
Yes the format is the same
 

Joseph111

New Member
Joined
Jan 10, 2021
Messages
19
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

You are already looping and looking for a match on the date, and you're grabbing the data only when the dates match, why still use Vlookup to search for the date?

VBA Code:
For Each Range1 In Sheet1.Range("Z13:Z500")   '<-- you can loop on column Z as well
If Date1 = Range1.Value Then
Det = "Êîä íà Àñîðòèìåíòà (Article code):  " & Cells(Range1.Row, "K").Value  '<-- use Range1.Row to get the matching row number since you're already looping
Det = Det & vbNewLine & "Èìå íà Àñîðòèìåíòà (Article name):  " & Cells(Range1.Row, "L").Value

etc..
Hi

I fixed the code as you sad but it`s not working yet. It may be the data variables are not the same type? What do you think

Sub Check_equpment1_click()
Worksheets("Production_program").Activate
Dim ans1 As Integer
ans1 = MsgBox("Ñìÿíà íà àñîðòèìåíò ïî äàòà/Check Job change by Date", vbQuestion + vbYesNo + vbDefaultButton2, "Equipment")
If ans1 = vbYes Then
On Error GoTo MyErrorHandler1:
Dim Date1 As String
Dim Range1 As Range
Date1 = InputBox("Âúâåäè äàòà/Enter date:", Title:="Equipment by date")
For Each Range1 In Sheet1.Range("Z13:Z500")
If Date1 = Range1.Value Then
Det = "Êîä íà Àñîðòèìåíòà (Article code): " & Cells(Range1.Row, "H").Value
Det = Det & vbNewLine & "Èìå íà Àñîðòèìåíòà (Article name): " & Cells(Range1.Row, "I").Value
Det = Det & vbNewLine & "Ëèíèÿ (Line): " & Cells(Range1.Row, "J").Value
Det = Det & vbNewLine & "Ìàøèíà (Machine): " & Cells(Range1.Row, "K").Value
Det = Det & vbNewLine & "Äîëíè Çâåçäè (Lower starwheels): " & Cells(Range1.Row, "L").Value
Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "M").Value
Det = Det & vbNewLine & "Ãîðíè Çâåçäè (Upper starwheels): " & Cells(Range1.Row, "N").Value
Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "O").Value
Det = Det & vbNewLine & "Øíåê (Infeed screw): " & Cells(Range1.Row, "P").Value
Det = Det & vbNewLine & "Êàëèáúð (Plug gauge): " & Cells(Range1.Row, "Q").Value
Det = Det & vbNewLine & "Èçõîäÿùè ðåëñè - äîëíè (outfeed guides lower): " & Cells(Range1.Row, "R").Value
Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "S").Value
Det = Det & vbNewLine & "Èçõîäÿùè ðåëñè - ãîðíè (outfeed guides upper): " & Cells(Range1.Row, "T").Value
Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "U").Value
MsgBox "" & vbNewLine & Det
Exit For
End If
Next
MyErrorHandler1:
If Err.Number = 1004 Then
End If
End If
End Sub
 

aRandomHelper

Board Regular
Joined
Jan 14, 2021
Messages
188
Office Version
  1. 2016
Platform
  1. Windows
Seems you're only looking for the first match, in that case, you can try using .Find instead.

Try:
VBA Code:
Sub Check_equpment1_click()
    Worksheets("Production_program").Activate
    Dim ans1 As Integer
    ans1 = MsgBox("Ñìÿíà íà àñîðòèìåíò ïî äàòà/Check Job change by Date", vbQuestion + vbYesNo + vbDefaultButton2, "Equipment")
    If ans1 = vbYes Then
        On Error GoTo MyErrorHandler1:
        Dim Date1 As String
        Dim Range1 As Range
        Date1 = InputBox("Âúâåäè äàòà/Enter date:", Title:="Equipment by date")
        Set Range1 = Sheet1.Range("Z13:Z500").Find(Date1, LookIn:=xlValues, lookat:=xlWhole)
        If Not Range1 Is Nothing Then
            Det = "Êîä íà Àñîðòèìåíòà (Article code): " & Cells(Range1.Row, "H").Value
            Det = Det & vbNewLine & "Èìå íà Àñîðòèìåíòà (Article name): " & Cells(Range1.Row, "I").Value
            Det = Det & vbNewLine & "Ëèíèÿ (Line): " & Cells(Range1.Row, "J").Value
            Det = Det & vbNewLine & "Ìàøèíà (Machine): " & Cells(Range1.Row, "K").Value
            Det = Det & vbNewLine & "Äîëíè Çâåçäè (Lower starwheels): " & Cells(Range1.Row, "L").Value
            Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "M").Value
            Det = Det & vbNewLine & "Ãîðíè Çâåçäè (Upper starwheels): " & Cells(Range1.Row, "N").Value
            Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "O").Value
            Det = Det & vbNewLine & "Øíåê (Infeed screw): " & Cells(Range1.Row, "P").Value
            Det = Det & vbNewLine & "Êàëèáúð (Plug gauge): " & Cells(Range1.Row, "Q").Value
            Det = Det & vbNewLine & "Èçõîäÿùè ðåëñè - äîëíè (outfeed guides lower): " & Cells(Range1.Row, "R").Value
            Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "S").Value
            Det = Det & vbNewLine & "Èçõîäÿùè ðåëñè - ãîðíè (outfeed guides upper): " & Cells(Range1.Row, "T").Value
            Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "U").Value
            MsgBox "" & vbNewLine & Det
        End If
MyErrorHandler1:
        If Err.Number = 1004 Then
        End If
    End If
End Sub
 

Joseph111

New Member
Joined
Jan 10, 2021
Messages
19
Office Version
  1. 2016
Platform
  1. Windows
Seems you're only looking for the first match, in that case, you can try using .Find instead.

Try:
VBA Code:
Sub Check_equpment1_click()
    Worksheets("Production_program").Activate
    Dim ans1 As Integer
    ans1 = MsgBox("Ñìÿíà íà àñîðòèìåíò ïî äàòà/Check Job change by Date", vbQuestion + vbYesNo + vbDefaultButton2, "Equipment")
    If ans1 = vbYes Then
        On Error GoTo MyErrorHandler1:
        Dim Date1 As String
        Dim Range1 As Range
        Date1 = InputBox("Âúâåäè äàòà/Enter date:", Title:="Equipment by date")
        Set Range1 = Sheet1.Range("Z13:Z500").Find(Date1, LookIn:=xlValues, lookat:=xlWhole)
        If Not Range1 Is Nothing Then
            Det = "Êîä íà Àñîðòèìåíòà (Article code): " & Cells(Range1.Row, "H").Value
            Det = Det & vbNewLine & "Èìå íà Àñîðòèìåíòà (Article name): " & Cells(Range1.Row, "I").Value
            Det = Det & vbNewLine & "Ëèíèÿ (Line): " & Cells(Range1.Row, "J").Value
            Det = Det & vbNewLine & "Ìàøèíà (Machine): " & Cells(Range1.Row, "K").Value
            Det = Det & vbNewLine & "Äîëíè Çâåçäè (Lower starwheels): " & Cells(Range1.Row, "L").Value
            Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "M").Value
            Det = Det & vbNewLine & "Ãîðíè Çâåçäè (Upper starwheels): " & Cells(Range1.Row, "N").Value
            Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "O").Value
            Det = Det & vbNewLine & "Øíåê (Infeed screw): " & Cells(Range1.Row, "P").Value
            Det = Det & vbNewLine & "Êàëèáúð (Plug gauge): " & Cells(Range1.Row, "Q").Value
            Det = Det & vbNewLine & "Èçõîäÿùè ðåëñè - äîëíè (outfeed guides lower): " & Cells(Range1.Row, "R").Value
            Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "S").Value
            Det = Det & vbNewLine & "Èçõîäÿùè ðåëñè - ãîðíè (outfeed guides upper): " & Cells(Range1.Row, "T").Value
            Det = Det & vbNewLine & "Ìÿñòî (Place): " & Cells(Range1.Row, "U").Value
            MsgBox "" & vbNewLine & Det
        End If
MyErrorHandler1:
        If Err.Number = 1004 Then
        End If
    End If
End Sub
I tried but without success, nothing happened when I inputted the date in the box
 

aRandomHelper

Board Regular
Joined
Jan 14, 2021
Messages
188
Office Version
  1. 2016
Platform
  1. Windows
nothing happened when I inputted the date in the box
Can you try doing a "Ctrl + F" find on your worksheet, entering the same date that you typed into the InputBox.
Does it find anything?

If it does find something, then most likely your Sheet1 reference is wrong. Your worksheet's codename is probably not Sheet1. Remove the red Sheet1. from this line.

Set Range1 = Sheet1.Range("Z13:Z500").Find(Date1, LookIn:=xlValues, lookat:=xlWhole)
 

Watch MrExcel Video

Forum statistics

Threads
1,123,281
Messages
5,600,705
Members
414,401
Latest member
grenona2020

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
Top