Create a list from certain cells

[Trueblue862]

Hi, this is only my second thread, thankyou for the great help I received in the first one.

I'm helping a friend set up a home delivery fruit and veg business and I'm up to my final stage in this project, I need to generate a picking list from my invoice. When I finalise the invoice I need it to copy across the products and quantity of each along with the delivery address and invoice number to aid with packing products into the correct box. Then if it's not too difficult I need to sort by product. I'm well out of my depth on this project, but have welcomed the challenge it has presented. It has been a very steep learning curve, but I can't help but feel I really need to do a course on VBA to do it effectivly.

This is the code I have at the moment, I've adapted it from something I found online.
I'm not fluent enough in coding to see where it's wrong.
Any help would be greatly appreciated.

Sub PackingList()
Dim InvoiceNumber As Integer
Dim Description As String
Dim Address As String
Dim Quantity As Integer
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").Select
         InvoiceNumber = Ws.Range("E4")
            Description = Ws.Range("C14:C33")
               Quantity = Ws.Range("B14:B33")
                  Address = Ws.Range("B8")
            Worksheets("Packing List").Select
         Worksheets("Packing List").Range("A1").Select
     If Worksheets("Packing List").Range("A1").Offset(1, 0) <> "" Then
    Worksheets("Packing List").Range("A1").End(x1Down).Select
End If
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = InvoiceNumber
End Sub

This is my invoice

Ordering Sheet ver 2.xlsm
	A	B	C	D	E	F	G	H	I	J
1		Ward's Produce		INVOICE
2		somebody@outlook.com		ABN:	99 999 999 999
3		Sometown, Qld		DATE:	May 31, 2020
4		4650		INVOICE #	163
5		Phone: 1111 111 111
6		Bill To:
7			Delivery Details		0
8
9
10
11		0000000000
12
13		Quantity	DESCRIPTION	Unit Price	AMOUNT
14					$ -
15					$ -
16					$ -
17					$ -
18					$ -
19					$ -
20					$ -
21					$ -
22					$ -
23					$ -
24					$ -
25					$ -
26					$ -
27					$ -
28					$ -
29					$ -
30					$ -
31					$ -
32					$ -
33					$ -
34				SUBTOTAL	$ -
35				DELIVERY
36				TOTAL	$ -
37
38		THANK YOU FOR YOUR BUSINESS!
39
40
41
42
Invoice

Cell Formulas
Range	Formula
E3	E3	=TODAY()
E7	E7	=IFERROR(XLOOKUP(B7,Table2[[#All],[Customer Name]],Table2[[#All],[Delivery Day]]),"")
B8	B8	=IFERROR(XLOOKUP(B7,Table2[[#All],[Customer Name]],Table2[[#All],[Address]]),"")
B9	B9	=IFERROR(XLOOKUP(B7,Table2[[#All],[Customer Name]],Table2[[#All],[City]]),"")
B10	B10	=IFERROR(XLOOKUP(B7,Table2[[#All],[Customer Name]],Table2[[#All],[Postcode ]]),"")
B11	B11	=IFERROR(XLOOKUP(B7,Table2[[#All],[Customer Name]],Table2[[#All],[Phone Number]]),"")
D14:D17	D14	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C1:C98,Sheet1!B1:B98),"")
D18	D18	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D19	D19	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D20	D20	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D21	D21	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D22	D22	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D23	D23	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D24	D24	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D25	D25	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D26	D26	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D27	D27	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D28	D28	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D29	D29	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D30	D30	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D31	D31	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D32	D32	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
D33	D33	=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
E14:E33	E14	=PRODUCT([@[Unit Price]],[@Quantity])
E34	E34	=SUBTOTAL(109,[AMOUNT])
E35	E35	=IFERROR(LOOKUP(Invoice[[#Totals],[AMOUNT]],{25;40},7),"")
E36	E36	=SUM(E34:E35)

Named Ranges
Name	Refers To	Cells
Sheet1!Print_Area	=Sheet1!$C:$C,Sheet1!$E:$E,Sheet1!$G:$G,Sheet1!$I:$I,Sheet1!$K:$N	D14

This is my packing list

Ordering Sheet ver 2.xlsm
	A	B	C	D	E
1	Description	Quantity	Unit	Invoice Number	Address
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Packing List

Cells with Data Validation
Cell	Allow	Criteria
A2	List	=Sheet1!$Y$1#

 

[ask2tsp]

This sub adds the invoice to the packing list. Call it when needed. Please test on a copy of your workbook.

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

 

[Trueblue862]

Thank you, it works perfectly.