How to Split a Value and check if it is included in a database

Question

everyone. I have material list that includes part number, description and quantity. I need to check whether my parts are in our minimum stock list. After that If it is in stock list, i need to put "N" letter, if it is not in the list, put "Y" letter. But the tricy point is, those values are joined values, it needs to be seperated before to check it. And also output values should be joined as well. I will put an sample

Here is material data base(Orderlines)sheet

I have tried this code below. If it looks terrible, so sorry to bother you :) Because Im mixed everything. Because Im really new. If you help me I would be appreicate

Sub Check_MSL()

Dim mylastrow6 As Long

Dim mslfile As String

Dim mslsheet As Worksheet

Dim mslvalues As Variant

Dim lookuprange As Range

Dim lookupvalue As Variant

Dim i As Long, j As Long

Dim x As Long
'Set file path for database file

mslfile = "H:\05-Planning Engineering\blablablaProcedure\MSL.xlsx"

Workbooks.Open (mslfile)

Set mslsheet = ActiveWorkbook.Sheets("OrderLines") 'Update sheet name if necessary

mylastrow6 = mslsheet.Cells(mslsheet.Rows.Count, "A").End(xlUp).Row ' Get last row of data in column A

mslvalues = mslsheet.Range("A1:A" & mylastrow6).Value 'Store values in array

Workbooks("MSL.xlsx").Close SaveChanges:=False ' Close database file without saving


Dim myNumbs As Variant

For x = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, "D").End(xlUp).Row

myNumbs = Array("B" & x)

Dim y As Long, arr() As String

For y = LBound(myNumbs) To UBound(myNumbs)

arr = Split(myNumbs(y), ";")

If Application.WorksheetFunction.CountIf(mslvalues, myNumbs(y)) Then

Sheets("Materials").Range("E2").Value = "N"

Else

Sheets("Materials").Range("E2").Value = "Y"


End If

Next

Next

End Sub

Answer 1

I made some modifications in the code. If it is possible only at the end of the execution close the Orderlines it is easier to refer to the actual range of it for the Find method.

Sub Check_MSL()

Dim mylastrow6 As Long

Dim mslfile As String

Dim mslsheet As Worksheet

Dim mslvalues As Range 'Variant

Dim lookuprange As Range

Dim lookupvalue As Variant

Dim i As Long, j As Long

Dim x As Long
'Set file path for database file

Set materials = ActiveSheet

mslfile = "H:\05-Planning Engineering\blablablaProcedure\MSL.xlsx"

Workbooks.Open (mslfile)

Set mslsheet = ActiveWorkbook.Sheets("OrderLines") 'Update sheet name if necessary

mylastrow6 = mslsheet.Cells(mslsheet.Rows.Count, "A").End(xlUp).Row ' Get last row of data in column A

Set mslvalues = mslsheet.Range("A1:A" & mylastrow6)  ' .Value 'Store values in array

'Workbooks("MSL.xlsx").Close SaveChanges:=False ' Close database file without saving


'Dim myNumbs As Variant

'  For x = 2 To activesheet.Cells(activesheet.Rows.Count, "D").End(xlUp).Row
'  myNumbs = Array("B" & x)
'  Dim y As Long, arr() As String
'  For y = LBound(myNumbs) To UBound(myNumbs)
'    arr = Split(myNumbs(y), ";")
'    If Application.WorksheetFunction.CountIf(mslvalues, myNumbs(y)) Then
'      Sheets("Materials").Range("E2").Value = "N"
'    Else
'      Sheets("Materials").Range("E2").Value = "Y"
'    End If
'  Next y
'Next x


For x = 2 To materials.Cells(materials.Rows.Count, "D").End(xlUp).Row
  arr = Split(materials.Range("B" & x), ";")
  For y = 0 To UBound(arr)
    If Not mslvalues.Find(arr(y), , xlFormulas, xlWhole) Is Nothing Then
      materials.Cells(x, "E") = materials.Cells(x, "E") & "N,"
    Else
      materials.Cells(x, "E") = materials.Cells(x, "E") & "Y,"
    End If
  Next y
  materials.Cells(x, "E") = Left(materials.Cells(x, "E"), Len(materials.Cells(x, "E")) - 1)
Next x

Workbooks("MSL.xlsx").Close SaveChanges:=False ' Close database file without saving

End Sub