400 Error Help.

[Trueblue862]

Hi, I have this piece of code which saves and enters data from an invoice into various locations in a workbook. It was working perfectly last week. I just tried to use it tonight and I'm getting a 400 error. I think it is failing in the PackingList sub, it appears to work up until there.

I have absolutely no idea as to what is going wrong, any help would be appreciated.

Sub Macro1()
response = MsgBox("Are You Sure You want to Finalise this Invoice?", vbYesNo)
 
If response = vbNo Then
     Exit Sub
End If
 Call AddValue
 Call PackingList
 Call Sort_Pack
     Application.Dialogs(xlDialogPrint).Show
    Dim NewFN As Variant
    NewFN = "D:\MARK\Invoices\Invoices\Invoice" & Range("E4").Value & ".pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFN, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
    Range("E4").Value = Range("E4").Value + 1
    Range("b7").ClearContents
    Range("B14:B33").ClearContents
    Range("c14:c33").ClearContents
End Sub
Sub AddValue()
Dim cVal As String, rVal As String
Dim fCol As Range, fRow As Range, cl As Range
Dim ws As Worksheet
        Set ws = Worksheets("invoice")
    If ws.Range("E7").Value = "" Then Exit Sub
For Each cl In ws.Range("C14:C33")
    If cl.Value = "" Then
        Exit For
    ElseIf cl.Offset(0, -1).Value = "" Then
        MsgBox "Quantity missing from Invoice!", vbOKOnly
        End
    End If
Next
For Each cl In ws.Range("C14:C33")
    If cl.Value <> "" Then
        With Worksheets("Sheet1")
            cVal = ws.Range("E7").Value
            rVal = cl.Value
            On Error Resume Next
            Set fCol = .Range("D1,f1,h1,j1,l1").Find(cVal, , xlValues, xlWhole, , False)
                If fCol Is Nothing Then
                    MsgBox cVal & "Check Delivery Day & Product!", vbCritical
                    End
                End If
            Set fRow = .Range("C2:C101").Find(rVal)
                If fRow Is Nothing Then
                    MsgBox rVal & "Check Delivery Day & Product!", vbCritical
                    End
                End If
            On Error GoTo 0
            .Cells(fRow.Row, fCol.Column).Value = cl.Offset(0, -1).Value
        End With
    End If
Next cl
End Sub





Sub PackingList()
    Dim Description As String
    Dim Quantity    As Integer
    
    Dim invoiceRow  As Long
    Dim packlistRow As Long
    
    Dim ws As Worksheet
    Set ws = Worksheets("Invoice")
    
    Dim pl As Worksheet
    Set pl = Worksheets("Packing List")
    
    Dim invoiceNumber As Integer
    invoiceNumber = ws.Range("E4")
    
    Dim Address As String
    Address = ws.Range("B8")
    
    'Set packlist row to the first available
    packlistRow = pl.Range("A1000").End(xlUp).Row + 1

    invoiceRow = 14
    
        Description = ws.Cells(invoiceRow, 3)
        Quantity = ws.Cells(invoiceRow, 2)
    While (Description > "") And (invoiceRow < 34)
        pl.Cells(packlistRow, 1).Value = Description
        pl.Cells(packlistRow, 2).Value = Quantity
        pl.Cells(packlistRow, 4).Value = invoiceNumber
        pl.Cells(packlistRow, 5).Value = Address
        
        invoiceRow = invoiceRow + 1
        packlistRow = packlistRow + 1
        
        Description = ws.Cells(invoiceRow, 3)
        If Description > "" Then Quantity = ws.Cells(invoiceRow, 2)
    Wend
    
End Sub
Sub Sort_Pack()
With Worksheets("Packing List").Range("A3").CurrentRegion
    .Sort Key1:=.Columns(1), Header:=xlYes, Order1:=xlAscending
End With
        
End Sub

 

[Trevor G]

Have you stepped through your code to see if it picks up a particular line of code? If you try this hopefully it should point to the issue.
If you Tap in the first part of the macro and then press F8 on the keyboard and repeat it should go through each line until it points to the problem.

Another question is have you set Excel to trusted access to Visual Basic Projects, follow these steps

• Tap File > Options > Customize Ribbon.
• Tap the Main Tabs > choose the Developer check box.
• In the Code group > and Developer Tab > tap Macro Security.
• Then under Developer Macro Settings > choose the Trust access to the VBA project object model checkbox

 

[Trueblue862]

Yes I have trusted the macros in the sheet.

It fails after it highlights this row in the sub listed below. It's strange how it was working perfectly last week, stepped away for the week and now it doesn't work.

It gives a Run-time Error1004: Application-defined or object-defined error.

 pl.Cells(packlistRow, 1).Value = Description

Sub PackingList()
    Dim Description As String
    Dim Quantity    As Integer
   
    Dim invoiceRow  As Long
    Dim packlistRow As Long
   
    Dim ws As Worksheet
    Set ws = Worksheets("Invoice")
   
    Dim pl As Worksheet
    Set pl = Worksheets("Packing List")
   
    Dim invoiceNumber As Integer
    invoiceNumber = ws.Range("E4")
   
    Dim Address As String
    Address = ws.Range("B8")
   
    'Set packlist row to the first available
    packlistRow = pl.Range("A1000").End(xlUp).Row + 1

    invoiceRow = 14
   
        Description = ws.Cells(invoiceRow, 3)
        Quantity = ws.Cells(invoiceRow, 2)
    While (Description > "") And (invoiceRow < 34)
        pl.Cells(packlistRow, 1).Value = Description
        pl.Cells(packlistRow, 2).Value = Quantity
        pl.Cells(packlistRow, 4).Value = invoiceNumber
        pl.Cells(packlistRow, 5).Value = Address
       
        invoiceRow = invoiceRow + 1
        packlistRow = packlistRow + 1
       
        Description = ws.Cells(invoiceRow, 3)
        If Description > "" Then Quantity = ws.Cells(invoiceRow, 2)
    Wend
   
End Sub

 

[Trevor G]

Can you recover a previous version of the workbook that was working before you were away?

 

[DanteAmor]

Do you have the "Packing List" sheet protected?

 

[Trueblue862]

Do you have the "Packing List" sheet protected?

Yes it is, I just realised that I didn’t test the code after I protected the worksheet. Is there a way to allow the macro to enter data but prevent manual data entry?

 

[DanteAmor]

Is there a way to allow the macro to enter data

Try this, change "abc" for your password

Sub PackingList()
    Dim Description As String
    Dim Quantity    As Integer
   
    Dim invoiceRow  As Long
    Dim packlistRow As Long
   
    Dim ws As Worksheet
    Set ws = Worksheets("Invoice")
   
    Dim pl As Worksheet
    Set pl = Worksheets("Packing List")
   
    Dim invoiceNumber As Integer
    invoiceNumber = ws.Range("E4")
   
    Dim Address As String
    Address = ws.Range("B8")
   
    'Set packlist row to the first available
    packlistRow = pl.Range("A1000").End(xlUp).Row + 1

    invoiceRow = 14
   
    Description = ws.Cells(invoiceRow, 3)
    Quantity = ws.Cells(invoiceRow, 2)
    
    pl.Unprotect "abc"
    While (Description > "") And (invoiceRow < 34)
        pl.Cells(packlistRow, 1).Value = Description
        pl.Cells(packlistRow, 2).Value = Quantity
        pl.Cells(packlistRow, 4).Value = invoiceNumber
        pl.Cells(packlistRow, 5).Value = Address
       
        invoiceRow = invoiceRow + 1
        packlistRow = packlistRow + 1
       
        Description = ws.Cells(invoiceRow, 3)
        If Description > "" Then Quantity = ws.Cells(invoiceRow, 2)
    Wend
    pl.Protect "abc"
   
End Sub

 

[Trueblue862]

Ok, thank you, I’ll give it a try after work tomorrow.

 

[DanteAmor]

I also made some adjustments to your code, sometimes it is not necessary to use variables, try the following:

Sub PackingList()
  Dim invoiceRow As Long, packlistRow As Long
  Dim ws As Worksheet, pl As Worksheet
  
  Set ws = Worksheets("Invoice")
  Set pl = Worksheets("Packing List")
  invoiceRow = 14
  packlistRow = pl.Range("A" & Rows.Count).End(xlUp).Row + 1  'packlist row first available
  
  pl.Unprotect "abc"
  While ws.Cells(invoiceRow, 3) <> "" And invoiceRow < 34
    pl.Cells(packlistRow, 1).Value = ws.Cells(invoiceRow, 3)
    pl.Cells(packlistRow, 2).Value = ws.Cells(invoiceRow, 2)
    pl.Cells(packlistRow, 4).Value = ws.Range("E4")
    pl.Cells(packlistRow, 5).Value = ws.Range("B8")
    invoiceRow = invoiceRow + 1
    packlistRow = packlistRow + 1
  Wend
  pl.Protect "abc"
End Sub

 

[Trueblue862]

Thank you, it's working now.