Invoice totals to weekly order sheet

Trueblue862

Board Regular
Joined
May 24, 2020
Messages
146
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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.

VBA Code:
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

Well-known Member
Joined
Dec 30, 2008
Messages
11,958
Office Version
  1. 365
Platform
  1. Windows
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.
VBA Code:
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
 

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

Trueblue862

Board Regular
Joined
May 24, 2020
Messages
146
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Dec 30, 2008
Messages
11,958
Office Version
  1. 365
Platform
  1. Windows
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.

 

Trueblue862

Board Regular
Joined
May 24, 2020
Messages
146
Office Version
  1. 365
Platform
  1. Windows
Ordering Sheet ver 2.xlsm
ABCDEFGHIJK
1Ward's ProduceINVOICE
2wardproduce@outlook.comABN: 68 245 703 883
3Aldershot, QldDATE:May 25, 2020
44650INVOICE #150
5Phone: 0432 270 388
6Bill To:
7Delivery Details0
8 
9 
10 
110000000000
12
13QuantityDESCRIPTIONUnit PriceAMOUNT
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
38THANK YOU FOR YOUR BUSINESS!
39
Invoice
Cell Formulas
RangeFormula
E3E3=TODAY()
E7E7=IFERROR(XLOOKUP(B7,Customers!A2:A116,Table2[Delivery Day]),"")
B8B8=IFERROR(XLOOKUP(B7,Customers!A2:A116,Table2[Address]),"")
B9B9=IFERROR(XLOOKUP(B7,Customers!A2:A116,Table2[City]),"")
B10B10=IFERROR(XLOOKUP(B7,Customers!A2:A116,Table2[[Postcode ]]),"")
B11B11=IFERROR(XLOOKUP(B7,Customers!A2:A116,Table2[Phone Number]),"")
D14:D33D14=IFERROR(XLOOKUP([@DESCRIPTION],Sheet1!C4:C101,Sheet1!B4:B101),"")
E14:E33E14=PRODUCT([@[Unit Price]],[@Quantity])
E34E34=SUBTOTAL(109,[AMOUNT])
E35E35=IFERROR(LOOKUP(Invoice[[#Totals],[AMOUNT]],{25;40},7),"")
E36E36=SUM(E34:E35)
 

Trueblue862

Board Regular
Joined
May 24, 2020
Messages
146
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Ordering Sheet ver 2.xlsm
CDFHJLNOPQRSTU
1ProductsFridaySaturdaySundayNoshGoodstartTotal for OrderingKG/Units
4700g eggs Units
5Apples Kg Kg
6Avocadoes Units
7baby spinach Units
8Bananas cav kg Kg
9Bananas lady kg Kg
10Bananas sugar kg Kg
11Beans kg Kg
12Beetroot kg Kg
13Broccoli kg Kg
14Capsicum green kg Kg
15capsicum green single Units
16Capsicum red kg Kg
17capsicum red single Units
18carrots kg Kg
19Cauliflower Units
20celery Units
21Choko green kg Kg
22corn cob Units
23Cucumber con Units
24Cucumber leb kg Kg
25cucumber leb single Units
26Eggplant single Units
27Eggplants kg Kg
28garlic bulb Units
29Garlic russian kg Kg
30Ginger Units
31Grapes kg Kg
32lemon Units
33lettuce cos Units
34Lettuce iceberg Units
35Limes Units
36Manadarins kg Kg
37mesclun mix Units
38Mushrooms kg Kg
39Onions brown kg  Kg
40Onions red kg Kg
41Oranges kg Kg
42Passionfruit kg Kg
43Pears kg Kg
44Pineapple Units
45Plums kg Kg
46Potatoes brushed kg Kg
47Potatoes chats red kg Kg
48Potatoes washed kg Kg
49Pumpkin  Units
50Shallots Units
51Squash gold kg Kg
52Sweet pot gold kg Kg
53Sweet pot purple kg Kg
54Sweet pot white kg Kg
55Tomatoes cherry Units
56Tomatoes kg Kg
57Watermelon Units
58Zucchini 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
RangeFormula
N4:N101N4=SUM(E4,G4,I4,K4, M4)
O4:O101O4=IF(ISNUMBER(SEARCH("Kg",C4)),"Kg","Units")
Cells with Conditional Formatting
CellConditionCell FormatStop If True
N4:N101Cell Value=0textNO
C4:O101Expression=MOD(ROW(),2)=1textNO
N3:N101Cell Value=0textNO
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,958
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

This is only a quick edit, if it's not right then I'll have another look in more detail later.
VBA Code:
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

Board Regular
Joined
May 24, 2020
Messages
146
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Dec 30, 2008
Messages
11,958
Office Version
  1. 365
Platform
  1. Windows
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.
VBA Code:
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

Board Regular
Joined
May 24, 2020
Messages
146
Office Version
  1. 365
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,832
Messages
5,598,361
Members
414,233
Latest member
WolverineNurse

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top