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

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.