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
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
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
 
Upvote 0
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: 58
Upvote 0
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
 
Upvote 0
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..
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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)
 
Upvote 0

Forum statistics

Threads
1,213,556
Messages
6,114,284
Members
448,562
Latest member
Flashbond

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