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]

It makes sense, took me a while to spot the problem though. I forgot to make the last line dynamic so it was still looking at B14 every time rather than following the descriptions down the sheet. Hopefully this one is right,

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 = cl.Offset(0, -1).Value
        End With
    End If
Next cl
End Sub

 

[Trueblue862]

Thank you, works perfectly, I think.
I'll do a full check on it tomorrow after work, but it appears good.
Thank you so much with everything you have helped with.

 

[jasonb75]

You're welcome

I'll keep an eye on the thread in case you need any additional help with it, but if you need help with the other sheet that you have started on it would be best to start a new thread for that.

 

[Trueblue862]

One more question, is there a way of stopping the macro, which I’m calling this macro from, if this one fails

 

[jasonb75]

You can replace Exit Sub with End (2 places).

Before doing so, please read the Remarks section of the link below, if you need to work around any of the points listed there then it will need a different approach.
In addition to the things listed there, if you have used Application.Calculation = xlManual or similar in your code, using End will not reset these to their original state, such things need to be coded to switch back on first.

End statement (VBA)

Office VBA reference topic

docs.microsoft.com

 

[Trueblue862]

Thank you.

 

[Trueblue862]

Sorry to be a pain on this, is there a way to stop the macro if there is no data entered for the quantity on the invoice.

 

[jasonb75]

Do you want to stop completely or just skip the line with no quantity?

 

[Trueblue862]

Stop if possible

 

[jasonb75]

A quick untested edit. Note that I've used the code from post 21 as the starting base for the edit, so any changes that you may have made since will not be included (post 25 for example). There are also now 3 Exit Sub lines instead of 2.

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
        Exit For
    ElseIf c.Offset(0, -1).Value = "" Then
        MsgBox "Quantity missing from Invoice!", vbOKOnly
        Exit Sub
    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 & "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 = cl.Offset(0, -1).Value
        End With
    End If
Next cl
End Sub