VBA Vlookup

[Joseph111]

Please for help. Why it`s not works?

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

 

[Joseph111]

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)

Hello,

I tried with Ctrl+F and the date ( 15.1.2021) is finded, but when I inputted it into the inbox after that nothing happens.

Yes I change the name of the sheet in the code with mine but nothing

Do you want to send you the file with the data?

Thanks

 

[aRandomHelper]

Do you want to send you the file with the data?

If you could, that would definitely help solve the mystery; other than optimizations, the code should be already working.

 

[Joseph111]

If you could, that would definitely help solve the mystery; other than optimizations, the code should be already working.

Hello

How can attach the excel file larger than 1MB (2.13MB)?

Regards have a nice day!

 

[Fluff]

You cannot upload files here, you would need to upload to a share site, such as OneDrive, GoogleDrive. Then mark for sharing & post the link you get.

 

[Joseph111]

Hello

How can attach the excel file larger than 1MB (2.13MB)?

Regards have a nice day!

test1.xlsm

1drv.ms

 

[Joseph111]

If you could, that would definitely help solve the mystery; other than optimizations, the code should be already working.

test1.xlsm

1drv.ms

 

[aRandomHelper]

Hey Joseph, so I took a look at your file. Well, the mystery was because you didn't remove the Sheet1 referencing, but instead replaced with your worksheet's name.

It should be either this:

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

or this:

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

for it to work.

 

[Joseph111]

Hello

Thanks for the reply, I rewrited the code according to the last advice, but again it doesn`t work. can you look the whole 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 = Worksheets("Production_program").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

 

[aRandomHelper]

When I opened your file on my computer, the dates are shown as e.g. "11/11/2020" or "11/30/2020". So when I ran the macro, I typed in exactly in that format, and it worked. It should work if you can find a result with Ctrl+F, because it's using the same method.

 

[Joseph111]

When I opened your file on my computer, the dates are shown as e.g. "11/11/2020" or "11/30/2020". So when I ran the macro, I typed in exactly in that format, and it worked. It should work if you can find a result with Ctrl+F, because it's using the same method.

It`s stange because on my computer the date is 11.11.2020. I used Ctrl+F and the function works ( the date is found) but when I inputted the same date in the same format in the inputbox after that there wasn`t box with the details. If I click on "cancel" then pop up empty box with details.