Invoice totals to weekly order sheet

[Trueblue862]

Hi I'm new here and a total VBA beginner.

I'm currently helping a friend of mine get his fruit and vegetable delivery business off the ground by building him a very simple invoicing system. So far I have gotten by with simply lurking here and adapting code as required. The final step I need to make is to get my invoice to transfer the quantity ordered into the weekly running total sheet based on the items ordered and delivery day. Delivery days are in the columns of the total sheet and the items ordered are in the rows.

I currently have this piece of code which runs from a button on the spreadsheet and saves, prints then clears the invoice.

Sub Macro1()
  Application.Dialogs(xlDialogPrint).Show
    Dim NewFN As Variant
    NewFN = "D:\MARK\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

My column variable is in cell E7.
My row variables are in cells C14-C33.
The data I want transferred to sheet 1 is in cells B14-B33

This is what I currently have.

Sub AddValue()
Dim column as String, row As String
Dim c As Single, r As Single
With Worksheets("Sheet1")
If .Range("E7").Value = "" Or .Range("C14").Value = "" Then Exit Sub
column = .Range("E7").Value
row = .Range("C14").Value
column = Application.Match(column, .Range("D1;f1;h1;j1;l1 "), 0)
 row = Application.Match(row, .Range("C4:C101"), 0)
.Range("A1").Offset(r, c).Value = .Range("B14").Value
End With
End Sub

I pulled it from the internet and modified it, but I'm sure that I've messed it up somewhere because it doesn't appear to actually do anything. I also need it integrated into the first piece of code, it can run at any point before the form is cleared.

I'm well and truly in over my head on this and would greatly appreciate any help I can get with this.

Thank you to anyone able to help in advance.

 

[jasonb75]

I've added error checks on both the row and column matches, if either is not found then it will warn and exit.

If you check the various Ranges in the code, you will see that some are prefixed with ws. these are referring to the invoice sheet, anything without the ws prefix will refer to sheet1. This also applies to .Cells in the last line, which is an alternative to Range that allows you to use column numbers instead of letters. I had to take a guess on which ones should refer to the invoice sheet so you might need to change them. Remember to leave the . prefix in place for any that should refer to sheet1.

If you get any code errors, click Debug and check which line is causing them.

If it is not quite working as expected e.g. result pasting in wrong place, then I will need to know what it is doing compared to what it should be doing.

Sub AddValue()
Dim cVal As String, rVal As String
Dim fCol As Range, fRow As Range
Dim ws As Worksheet
Set ws = Worksheets("invoice")
With Worksheets("Sheet1")
    If ws.Range("E7").Value = "" Or ws.Range("C14").Value = "" Then Exit Sub
    cVal = ws.Range("E7").Value
    rVal = ws.Range("C14").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 & "Not found!", vbCritical
            Exit Sub
        End If
    Set fRow = .Range("C4:C101").Find(rVal)
        If fRow Is Nothing Then
            MsgBox rVal & "Not found!", vbCritical
            Exit Sub
        End If
    On Error GoTo 0
    .Cells(fRow.Row, fCol.Column).Value = ws.Range("B14").Value
End With
End Sub

 

[Trueblue862]

YOU ARE AWESOME!!! Only one more thing, It is only copying the top line of the invoice, do I need to copy the With section of the code for every cell or is there a way to get it to simply get it continue down the page.

 

[jasonb75]

You could wrap the whole thing in a loop to cycle through the other lines using For Each

Not something I can do without the layout of both sheets and detail on how each relates to the other. You can use XL2BB to post examples from your file to the forum.

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com

 

[Trueblue862]

Ordering Sheet ver 2.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1		Ward's Produce		INVOICE
2		wardproduce@outlook.com		ABN:	68 245 703 883
3		Aldershot, Qld		DATE:	May 25, 2020
4		4650		INVOICE #	150
5		Phone: 0432 270 388
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
Invoice

Cell Formulas
Range	Formula
E3	E3	=TODAY()
E7	E7	=IFERROR(XLOOKUP(B7,Customers!A2:A116,Table2[Delivery Day]),"")
B8	B8	=IFERROR(XLOOKUP(B7,Customers!A2:A116,Table2[Address]),"")
B9	B9	=IFERROR(XLOOKUP(B7,Customers!A2:A116,Table2[City]),"")
B10	B10	=IFERROR(XLOOKUP(B7,Customers!A2:A116,Table2[[Postcode ]]),"")
B11	B11	=IFERROR(XLOOKUP(B7,Customers!A2:A116,Table2[Phone Number]),"")
D14:D33	D14	=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)

 

[Trueblue862]

Ordering Sheet ver 2.xlsm
			C	D		F		H		J		L		N	O	P	Q	R	S	T	U
1			Products	Friday		Saturday		Sunday		Nosh		Goodstart		Total for Ordering	KG/Units
4			700g eggs												Units
5			Apples Kg												Kg
6			Avocadoes												Units
7			baby spinach												Units
8			Bananas cav kg												Kg
9			Bananas lady kg												Kg
10			Bananas sugar kg												Kg
11			Beans kg												Kg
12			Beetroot kg												Kg
13			Broccoli kg												Kg
14			Capsicum green kg												Kg
15			capsicum green single												Units
16			Capsicum red kg												Kg
17			capsicum red single												Units
18			carrots kg												Kg
19			Cauliflower												Units
20			celery												Units
21			Choko green kg												Kg
22			corn cob												Units
23			Cucumber con												Units
24			Cucumber leb kg												Kg
25			cucumber leb single												Units
26			Eggplant single												Units
27			Eggplants kg												Kg
28			garlic bulb												Units
29			Garlic russian kg												Kg
30			Ginger												Units
31			Grapes kg												Kg
32			lemon												Units
33			lettuce cos												Units
34			Lettuce iceberg												Units
35			Limes												Units
36			Manadarins kg												Kg
37			mesclun mix												Units
38			Mushrooms kg												Kg
39			Onions brown kg												Kg
40			Onions red kg												Kg
41			Oranges kg												Kg
42			Passionfruit kg												Kg
43			Pears kg												Kg
44			Pineapple												Units
45			Plums kg												Kg
46			Potatoes brushed kg												Kg
47			Potatoes chats red kg												Kg
48			Potatoes washed kg												Kg
49			Pumpkin												Units
50			Shallots												Units
51			Squash gold kg												Kg
52			Sweet pot gold kg												Kg
53			Sweet pot purple kg												Kg
54			Sweet pot white kg												Kg
55			Tomatoes cherry												Units
56			Tomatoes kg												Kg
57			Watermelon												Units
58			Zucchini kg												Kg
59															Units
60															Units
61															Units
62															Units
63															Units
64															Units
65															Units
66															Units
67															Units
68															Units
69															Units
70															Units
71															Units
72															Units
73															Units
74															Units
75															Units
76															Units
77															Units
78															Units
79															Units
80															Units
81															Units
82															Units
83															Units
84															Units
85															Units
86															Units
87															Units
88															Units
89															Units
90															Units
91															Units
92															Units
93															Units
94															Units
95															Units
96															Units
97															Units
98															Units
99															Units
100															Units
101															Units
102
103
104
Sheet1

Cell Formulas
Range	Formula
N4:N101	N4	=SUM(E4,G4,I4,K4, M4)
O4:O101	O4	=IF(ISNUMBER(SEARCH("Kg",C4)),"Kg","Units")

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
N4:N101	Cell Value	=0	text	NO
C4:O101	Expression	=MOD(ROW(),2)=1	text	NO
N3:N101	Cell Value	=0	text	NO

 

[Trueblue862]

This is what I'm working with.

 

[jasonb75]

This is only a quick edit, if it's not right then I'll have another look in more detail later.

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 c.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 & "Not found!", vbCritical
                    Exit Sub
                End If
            Set fRow = .Range("C4:C101").Find(rVal)
                If fRow Is Nothing Then
                    MsgBox rVal & "Not found!", vbCritical
                    Exit Sub
                End If
            On Error GoTo 0
            .Cells(fRow.Row, fCol.Column).Value = ws.Range("B14").Value
        End With
    End If
Next cl
End Sub

 

[Trueblue862]

Thank you.
It's not working, it came up with a runtime error, worst case I can copy and paste the previous piece of code down the page, changing the cell references as required.
You've already helped more than I could have ever imagined, I am incredibly grateful for your help.
I have a 12hr shift at work tomorrow and it's getting late here, Thank you for everything.

 

[jasonb75]

Which line caused the runtime error? (If you try to run it again and click debug it will be highlighted in yellow).
I did just notice one tiny error which I've corrected below, so that may well have been the cause.

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
        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 & "Not found!", vbCritical
                    Exit Sub
                End If
            Set fRow = .Range("C4:C101").Find(rVal)
                If fRow Is Nothing Then
                    MsgBox rVal & "Not found!", vbCritical
                    Exit Sub
                End If
            On Error GoTo 0
            .Cells(fRow.Row, fCol.Column).Value = ws.Range("B14").Value
        End With
    End If
Next cl
End Sub

 

[Trueblue862]

This is now running, but it is copying the quantity for the first row only into all the data points associated with whatever I select in the product description of the invoice. I hope that makes sense.