Macro - Receipt Entry - Do not want to receive all

SUGGESTED

Hi All,

I'm making a macro to post receipt entry based on PO number and the receipt number is pre-generated.

For the detail line, I do not want to receive all. But so far did not success.

How to prevent receive all?

Below is my code. I have set the quantity received.

Edit: Here is the full code

Private Sub ImportPO_Click()
 On Error GoTo ACCPACErrorHandler
 Dim mDBLinkCmpRW As AccpacCOMAPI.AccpacDBLink
 Set mDBLinkCmpRW = OpenDBLink(DBLINK_COMPANY, DBLINK_FLG_READWRITE)

 Dim mDBLinkSysRW As AccpacCOMAPI.AccpacDBLink
 Set mDBLinkSysRW = OpenDBLink(DBLINK_SYSTEM, DBLINK_FLG_READWRITE)

 Dim objExcelApp As Object
    Set objExcelApp = CreateObject("Excel.Application")
 Dim wb As Object
 Set wb = objExcelApp.Workbooks.Open(TextBox1.Value) 'OPEN the excel file
 Dim ws_one As Object
 Set ws_one = wb.Sheets(1)
 Set ws_two = wb.Sheets(2)

 'First is row, then Column
 'Read the rows
 Dim last_row As Long
 last_row_ws_one = ws_one.Cells(Rows.Count, 1).End(xlUp).Row
 last_row_ws_two = ws_two.Cells(Rows.Count, 1).End(xlUp).Row

 Debug.Print "last_row_ws_one=" & last_row_ws_one
 Debug.Print "last_row_ws_two=" & last_row_ws_two


 Dim PONUM As String
 For I = 2 To last_row_ws_one
  PONUM = ws_one.Cells(I, 1).Value
  ' TODO: To increase efficiency, comment out any unused DB links.

  Dim temp As Boolean

  '-----------------------------------
  'CREATE GRN
  Dim PORCP1header As AccpacCOMAPI.AccpacView
  Dim PORCP1headerFields As AccpacCOMAPI.AccpacViewFields
   mDBLinkCmpRW.OpenView "PO0700", PORCP1header
  Set PORCP1headerFields = PORCP1header.Fields

  Dim PORCP1detail1 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail1Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0710", PORCP1detail1
  Set PORCP1detail1Fields = PORCP1detail1.Fields

  Dim PORCP1detail2 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail2Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0695", PORCP1detail2
  Set PORCP1detail2Fields = PORCP1detail2.Fields

  Dim PORCP1detail3 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail3Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0718", PORCP1detail3
  Set PORCP1detail3Fields = PORCP1detail3.Fields

  Dim PORCP1detail4 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail4Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0714", PORCP1detail4
  Set PORCP1detail4Fields = PORCP1detail4.Fields

  Dim PORCP1detail5 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail5Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0699", PORCP1detail5
  Set PORCP1detail5Fields = PORCP1detail5.Fields

  Dim PORCP1detail6 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail6Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0705", PORCP1detail6
  Set PORCP1detail6Fields = PORCP1detail6.Fields

  Dim PORCP1detail7 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail7Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0703", PORCP1detail7
  Set PORCP1detail7Fields = PORCP1detail7.Fields

  Dim PORCP1detail8 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail8Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0696", PORCP1detail8
  Set PORCP1detail8Fields = PORCP1detail8.Fields

  Dim PORCP1detail9 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail9Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0717", PORCP1detail9
  Set PORCP1detail9Fields = PORCP1detail9.Fields

  Dim PORCP1detail10 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail10Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0721", PORCP1detail10
  Set PORCP1detail10Fields = PORCP1detail10.Fields

  Dim PORCP1detail11 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail11Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0719", PORCP1detail11
  Set PORCP1detail11Fields = PORCP1detail11.Fields

  Dim PORCP1detail12 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail12Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0697", PORCP1detail12
  Set PORCP1detail12Fields = PORCP1detail12.Fields

  Dim PORCP1detail13 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail13Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0704", PORCP1detail13
  Set PORCP1detail13Fields = PORCP1detail13.Fields

  Dim PORCP1detail14 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail14Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0789", PORCP1detail14
  Set PORCP1detail14Fields = PORCP1detail14.Fields

  Dim PORCP1detail15 As AccpacCOMAPI.AccpacView
  Dim PORCP1detail15Fields As AccpacCOMAPI.AccpacViewFields
  mDBLinkCmpRW.OpenView "PO0780", PORCP1detail15
  Set PORCP1detail15Fields = PORCP1detail15.Fields

  PORCP1header.Compose Array(PORCP1detail2, PORCP1detail1, PORCP1detail3, PORCP1detail4, PORCP1detail5, PORCP1detail6, PORCP1detail7, PORCP1detail8)

  PORCP1detail1.Compose Array(PORCP1header, PORCP1detail2, PORCP1detail5, Nothing, Nothing, PORCP1detail9, PORCP1detail14, PORCP1detail15)

  PORCP1detail2.Compose Array(PORCP1header, PORCP1detail1)

  PORCP1detail3.Compose Array(PORCP1header, PORCP1detail4, PORCP1detail5, PORCP1detail10)

  PORCP1detail4.Compose Array(PORCP1detail3, PORCP1detail5, PORCP1header, Nothing, Nothing, PORCP1detail11, PORCP1detail8)

  PORCP1detail5.Compose Array(PORCP1header, PORCP1detail2, PORCP1detail1, PORCP1detail4, PORCP1detail3, PORCP1detail6, PORCP1detail8)

  PORCP1detail6.Compose Array(PORCP1header, PORCP1detail5)

  PORCP1detail7.Compose Array(PORCP1header)

  PORCP1detail8.Compose Array(PORCP1detail4, PORCP1detail3, PORCP1header, PORCP1detail5, PORCP1detail12)

  PORCP1detail9.Compose Array(PORCP1detail1)

  PORCP1detail10.Compose Array(PORCP1detail3)

  PORCP1detail11.Compose Array(PORCP1detail4)

  PORCP1detail12.Compose Array(Nothing, PORCP1detail8, PORCP1detail4)

  PORCP1detail13.Compose Array(PORCP1detail8, PORCP1detail1)

  PORCP1detail14.Compose Array(PORCP1detail1, Nothing, Nothing)

  PORCP1detail15.Compose Array(PORCP1detail1, Nothing, Nothing)


  PORCP1header.Order = 1
  PORCP1header.Order = 0

  PORCP1headerFields("RCPHSEQ").PutWithoutVerification ("0") ' Receipt Sequence Key
  'Debug.Print PORCP1headerFields("RCPHSEQ").Value

  PORCP1header.Init
  PORCP1header.Order = 1
  temp = PORCP1detail1.Exists
  PORCP1detail1.RecordClear
  PORCP1detail3.RecordClear
  temp = PORCP1detail4.Exists
  PORCP1detail4.RecordClear
  PORCP1detail6.Init
  PORCP1detail2.Init
  PORCP1headerFields("PONUMBER").Value = PONUM ' Purchase Order Number

  'PORCP1header.Read
  temp = PORCP1header.Exists
  Debug.Print "PORCP1header temp:" & temp


  PORCP1headerFields("DATE").Value = ws_one.Cells(I, 2) ' Receipt Date

  PORCP1header.Order = 0
  PORCP1detail5Fields("LOADPORNUM").Value = PONUM ' Purchase Order Number
       PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("4") ' Function
  PORCP1detail5.Process
  PORCP1header.Order = 1
  PORCP1detail3Fields("PROCESSCMD").PutWithoutVerification ("1") ' Command
  PORCP1detail3.Process

  temp = PORCP1header.Exists


  Dim counter As Integer
  counter = 0

  For J = 2 To last_row_ws_two
   Debug.Print "Trim(CStr(ws_two.Cells(" & J & ", 1)))=" & Trim(CStr(ws_two.Cells(J, 1)))

   If Trim(PONUM) = Trim(CStr(ws_two.Cells(J, 2))) Then
    For K = 1 To PORCP1headerFields("LINES").Value


    PORCP1detail1Fields("RCPLREV").PutWithoutVerification (CStr(0 - K)) ' Line Number
    PORCP1detail1.Read

    If Trim(ws_two.Cells(J, 1).Value) = Trim(PORCP1detail1Fields("ITEMNO").Value) Then
     PORCP1detail1Fields("DTARRIVAL").Value = ws_one.Cells(I, 2) ' Arrival Date
     PORCP1detail1Fields("RQRECEIVED").Value = CStr(ws_two.Cells(J, 3).Value) ' Quantity Received

     Debug.Print "ITEMNO = " & PORCP1detail1Fields("ITEMNO").Value
     Debug.Print "DTARRIVAL=" & PORCP1detail1Fields("DTARRIVAL").Value
     Debug.Print "RQRECEIVED=" & PORCP1detail1Fields("RQRECEIVED").Value

     PORCP1detail1.Update
    End If
   Next K


  End If

 Next J

 PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("4") ' Function

 PORCP1detail5.Process
 PORCP1header.Order = 1
 PORCP1detail3Fields("PROCESSCMD").PutWithoutVerification ("1") ' Command
 PORCP1detail3.Process
 PORCP1detail5Fields("FUNCTION").Value = "6" ' Function
 PORCP1detail5.Process
 PORCP1detail3.Browse "(RCPHSEQ = 0)", 1
 PORCP1detail3.RecordClear
 PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("10") ' Function
 PORCP1detail5.Process
 temp = PORCP1header.Exists

 PORCP1headerFields("RCPNUMBER").Value = ws_one.Cells(I, 3) ' GRN generated by Vendor
 PORCP1header.Insert

 PORCP1detail5Fields("RCPHSEQ").PutWithoutVerification (CStr(PORCP1headerFields("RCPHSEQ").Value)) ' Receipt Sequence Key

 PORCP1detail5Fields("FUNCTION").PutWithoutVerification ("2") ' Function

 PORCP1detail5.Process
 PORCP1header.Init
 PORCP1header.Order = 0

 PORCP1headerFields("RCPHSEQ").PutWithoutVerification ("0") ' Receipt Sequence Key

 PORCP1header.Init
 PORCP1header.Order = 1
 temp = PORCP1detail1.Exists
 PORCP1detail1.RecordClear
 PORCP1detail3.RecordClear
 temp = PORCP1detail4.Exists
 PORCP1detail4.RecordClear
 PORCP1detail6.Init
 PORCP1detail2.Init

 Next I

 wb.Close
 Exit Sub

ACCPACErrorHandler:
 Dim lCount As Long
 Dim lIndex As Long

 If Errors Is Nothing Then
  MsgBox Err.Description
 Else
  lCount = Errors.Count

  If lCount = 0 Then
   MsgBox Err.Description
  Else
   For lIndex = 0 To lCount - 1
    MsgBox Errors.Item(lIndex)
    'MsgBox "The PO Number or GRN might be duplicated."
   Next
   Errors.Clear
  End If
  Resume Next

 End If

End Sub

My excel file look like this:

1st Sheet:

2nd Sheet: