Autofill Item name based on ID item in Excel VBA Userform

[liaaa]

Hello,
So I try to make a userform. The user only needs to fill in the ID item (column H) and the item name (column I) will be filled automatically. Is this possible for multiple ID ITEM in one textbox? So user will input multiple ID Items and then the Item name will be filled automatically. Or is there another alternative to do this?

This is the link for the file

Excel VBA Userform - Google Drive

drive.google.com

Thank you for your help

 

[Legacy 143009]

I remember your project

Range("H" & iRow).Value = IDITEM(j)
With Worksheets("ITEM")
Range("I" & iRow).Value = .Cells(Application.Match(IDITEM(j), .Range("A:A"),0), "B").Value
End With

But this code may give error if item number does not appear in ITEM sheet. It must exist.

 

[liaaa]

Hi,
Thank you very much for your response. I have tried it. Is it possible to make it like this?
There will be some items that don't have ID, so i must input the item name manually.

 

[Legacy 143009]

I see.. Then do it like quantity. Make an itemNames array. Input them with comma. Use like:

Range("I" & iRow).Value = itemNames(j)

 

[liaaa]

If i do like this, the item that have Id Will be filled automatically or i must also input it manually?

 

[Legacy 143009]

With this method you must input manually with seperating comma.
If you want automatically, then you must predifine the item list and try the first method.
Which one you want exactly?

 

[liaaa]

I want to try both method. For example, there are 4 items. item 1 & item 2 have Id, so i just need to input the id and items name Will be filled automatically. But item 3 & item 4 don't have id, so i must input the item name manually. Is it possible to do this in 1 userform?

 

[Legacy 143009]

Ok then this can be an option. Dots (.) are there to represent other code. You can remove them.

Sub test()
  Dim itemName As String
  With wBook.Sheets("Database")
  'Your other code
  'Your other code
  'Your other code
  .Range("H" & iRow).Value = IDITEM(j)
  If IsError(Application.Match(IDITEM(j), Worksheets("ITEM").Range("A:A"), 0)) Then
    itemName = InputBox("Please provide Item Name for ID: " & IDITEM(j))
  Else
    itemName = Worksheets("ITEM").Cells(Application.Match(IDITEM(j), Worksheets("ITEM").Range("A:A"), 0), "B").Value
  End If
  End With
  .Range("I" & iRow).Value = itemName
  .Range("J" & iRow).Value = QTY(j)
  'Your other code
  'Your other code
  'Your other code
End Sub

 

[liaaa]

Hi, I have tried your code, but it's not working.

Sub Submit()
  Application.ScreenUpdating = False
  Dim App As New Excel.Application
  Dim wBook As Excel.Workbook
  Dim FileName As String
  Dim iRow As Long
  FileName = ThisWorkbook.Path & "\Database.xlsm"
 
  Dim IDITEM As Variant
  Dim QTY As Variant
  Dim j As Long
  Dim itemName As String
 
  'CheckFile exist Or Not
  If Dir(FileName) = "" Then
    MsgBox "Database is missing!", vbOKOnly + vbCritical, "Error"
    Exit Sub
  End If
 
  ' Check to makesure the txtIDITEM is splittable
  If InStr(UserForm1.TxtIDITEM.Value, ",") > 0 Then
    IDITEM = Split(UserForm1.TxtIDITEM.Value, ",")
  Else
    IDITEM = Array(UserForm1.TxtIDITEM.Value)
  End If
 
  For j = LBound(IDITEM) To UBound(IDITEM)
 
    ' Check to makesure the txtQTY is splittable
    If InStr(UserForm1.TxtQTY.Value, ",") > 0 Then
      QTY = Split(UserForm1.TxtQTY.Value, ",")
    Else
      QTY = Array(UserForm1.TxtQTY.Value)
    End If
 
    Set wBook = App.Workbooks.Open(FileName)
    With wBook.Sheets("Database")
    iRow = .Range("A" & Application.Rows.Count).End(xlUp).Row + 1
    .Range("A" & iRow).Value = iRow - 1
    .Range("B" & iRow).Value = UserForm1.TxtNODOCUMENT.Value
    .Range("C" & iRow).Value = UserForm1.TxtNUMBER.Value
    .Range("D" & iRow).Value = [Text(Now()+1, "DD-MM-YYY")]
    .Range("E" & iRow).Value = UserForm1.CmbNIP.Value
    .Range("F" & iRow).Value = UserForm1.TxtPROJECTNAME.Value
    .Range("G" & iRow).Value = UserForm1.TxtNOCONTRACT.Value
    .Range("H" & iRow).Value = IDITEM(j)
    If IsError(Application.Match(IDITEM(j), Worksheets("ITEM").Range("A:A"), 0)) Then
        itemName = InputBox("Please provide Item Name for ID: " & IDITEM(j))
    Else
        itemName = Worksheets("ITEM").Cells(Application.Match(IDITEM(j), Worksheets("ITEM").Range("A:A"), 0), "B").Value
    End If
    End With
    .Range("I" & iRow).Value = itemName
    .Range("J" & iRow).Value = QTY(j)
    .Range("K" & iRow).Value = UserForm1.TxtSATUAN.Value
    .Range("L" & iRow).Value = UserForm1.TxtDELIVERYDATE.Value
    .Range("M" & iRow).Value = UserForm1.TxtSUPPLIER.Value
    .Range("N" & iRow).Value = Application.UserName
    End With

    wBook.Close savechanges:=True
    App.Quit
    Set App = Nothing
  Next

End Sub

And then appears error messages like this

 

[Legacy 143009]

Sorry, it's my bad

  End If
  End With

Delete End With here