Sub RecordSale2()
' SECOND VERSION OF RECORD SALE WITH OPTION TO ATTACH MONTHLY SUMMARY FILE
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Sheets("Sale").Unprotect
Sheets("Sale Records").Unprotect
Sheets("AR").Unprotect
Sheets("HG Invoice").Unprotect
Dim LastARRow As Long, LastSaleRecordsRow As Long, NewLastSalesRecordsRow As Long
Dim Customer, CustEmail, ClientCode, InvMo, InvYear As String
Dim InvDate As Date
Customer = Sheets("Sale").Range("Customer").Value
CustEmail = Application.WorksheetFunction.VLookup(Customer, Sheets("Customers").Range("A2:I50"), 9, False)
ClientCode = Application.WorksheetFunction.VLookup(Customer, Sheets("Customers").Range("A2:I50"), 2, False)
' DETERMINE INVOICE NUMBER AND PASTE
Dim Inv As Long, NewInv As Long
LastSaleRecordsRow = Worksheets("Sale Records").UsedRange.Rows.Count 'determines the # of rows used
Inv = Worksheets("Sale Records").Cells(LastSaleRecordsRow, 1) 'determines the last used Inv #
NewInv = Inv + 1 'increase Inv # by one
Range("SaleInvNo") = NewInv 'Copies new Inv # to the Sale sheet
Sheets("Sale Records").Cells(LastSaleRecordsRow + 1, 1) = NewInv 'Copies new INV # to the Sale Records sheet
LastARRow = Worksheets("AR").UsedRange.Rows.Count 'determines the # of rows used
Sheets("AR").Cells(LastARRow + 1, 1) = NewInv 'Copies new INV # to the AR sheet
'COPY DETAILS FROM SALE SHEET TO AR AND SALE RECORDS
Sheets("AR").Cells(LastARRow + 1, 2) = Sheets("Sale").Range("SaleDate") 'copies Date
Sheets("Sale Records").Cells(LastSaleRecordsRow + 1, 2) = Sheets("Sale").Range("SaleDate") 'copies Date
Sheets("AR").Cells(LastARRow + 1, 3) = Sheets("Sale").Range("Customer") 'copies Customer
Sheets("Sale Records").Cells(LastSaleRecordsRow + 1, 3) = Sheets("Sale").Range("Customer") 'copies Customer
Sheets("AR").Cells(LastARRow + 1, 4) = Sheets("Sale").Range("SaleTotal") 'copies GST inc Value
Sheets("AR").Cells(LastARRow + 1, 6) = Sheets("Sale").Range("SaleGST") 'copies GST
Sheets("AR").Cells(LastARRow + 1, 7) = Sheets("Sale").Range("SaleDueDate") 'copies Due Date
Sheets("AR").Cells(LastARRow + 1, 5).FormulaR1C1 = "=RC[-1]-RC[+5]-RC[+10]-RC[+15]" 'inputs formula to calculate amount owing
Sheets("AR").Cells(LastARRow + 1, 8).FormulaR1C1 = "=IF(RC[-3]>0,TODAY()-RC[-1],"""")" 'inputs formula to calculate overdue
Sheets("AR").Cells(LastARRow + 1, 12).FormulaR1C1 = "=IF(RC[-2]<>0,RC[-2]/RC[-8]*RC[-6],"""")" 'inputs formula to calculate GST portion of payment
Sheets("AR").Cells(LastARRow + 1, 17) = Sheets("AR").Cells(LastARRow + 1, 12) 'copies GST formula to 2nd payment
Sheets("AR").Cells(LastARRow + 1, 22) = Sheets("AR").Cells(LastARRow + 1, 12) 'copies GST formula to 3rd payment
'COPY SaleDetails TO SALE RECORDS
With Range("SaleDetails")
If Not IsEmpty(.Cells(2, 1)) Then
Range(.Cells(1, 1), .Cells(1, 1).End(xlDown)).Resize(, 5).Copy
Else: .Cells(1, 1).Resize(, 5).Copy
End If
End With
Sheets("Sale Records").Cells(LastSaleRecordsRow + 1, 4).PasteSpecial Paste:=xlPasteAllExceptBorders
'DELETE DATA VALIDATION
NewLastSalesRecordsRow = Worksheets("Sale Records").UsedRange.Rows.Count ' determine NewLastSaleRecordsRow
Range(Cells(LastSaleRecordsRow + 1, 5), Cells(NewLastSalesRecordsRow, 6)).Validation.Delete
'FILL INV#, DATE AND CUSTOMER TO MATCH SALE DESCRIPTION ENTRIES
Sheets("Sale Records").Select
Dim RowA As Long, RowD As Long
RowA = Range("A" & Rows.Count).End(xlUp).Row
RowD = Range("D" & Rows.Count).End(xlUp).Row
If RowD > RowA Then
Range("A" & RowA, "C" & RowD).FillDown
End If
'CLEAR DETAILS FROM PREVIOUS INVOICE
Sheets("HG Invoice").Range("TaxInvDescription2").ClearContents
Sheets("HG Invoice").Range("TaxInvAmount2").ClearContents
Sheets("HG Invoice").Range("TaxInvTax2").ClearContents
Sheets("HG Invoice").Range("TaxInvPaid").ClearContents
' CREATE INVOICE FROM SALE DATA
Sheets("HG Invoice").Range("TaxInvDate") = Sheets("Sale").Range("SaleDate")
InvDate = Sheets("Sale").Range("SaleDate").Value
Sheets("HG Invoice").Range("TaxInvNo") = Sheets("Sale").Range("SaleInvNo")
Sheets("HG Invoice").Range("TaxInvTerms") = Sheets("Sale").Range("SaleTerms")
Sheets("HG Invoice").Range("TaxInvDueDate") = Sheets("Sale").Range("SaleDueDate")
Sheets("HG Invoice").Range("TaxInvSubtotal") = Sheets("Sale").Range("SaleSubtotal")
Sheets("HG Invoice").Range("TaxInvGST") = Sheets("Sale").Range("SaleGST")
Sheets("HG Invoice").Range("TaxInvTotal") = Sheets("Sale").Range("SaleTotal")
Sheets("HG Invoice").Range("TaxInvPaid") = Sheets("Sale").Range("SalePaidToday")
Sheets("HG Invoice").Range("TaxInvCustomer") = Sheets("Sale").Range("Customer")
' COPY CUSTOMER DATA TO INVOICE
Dim CustRow As Long
Dim c As Range
With Range("CustomerName")
Set c = .Find(What:=Customer, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
CustRow = c.Row 'if code errors out here, customer name in Cellar is not EXACTLY the same as Customer range in Accounting
End With
Sheets("HG Invoice").Range("TaxInvAddress") = Sheets("Customers").Cells(CustRow, 3)
Sheets("HG Invoice").Range("TaxInvSuburb") = Sheets("Customers").Cells(CustRow, 4)
Sheets("HG Invoice").Range("TaxInvState") = Sheets("Customers").Cells(CustRow, 5)
Sheets("HG Invoice").Range("TaxInvPostCode") = Sheets("Customers").Cells(CustRow, 6)
Sheets("HG Invoice").Range("TaxInvCustABN") = Sheets("Customers").Cells(CustRow, 7)
'COPY SaleDetails TO INVOICE
With Range("SaleDetails")
If Not IsEmpty(.Cells(2, 1)) Then 'if more than one item in SaleDetails
Range(.Cells(1, 1), .Cells(1, 1).End(xlDown)).Resize(, 1).Copy 'copy Description
Sheets("HG Invoice").Range("TaxInvDescription").PasteSpecial Paste:=xlPasteAllExceptBorders
Range(.Cells(1, 1), .Cells(1, 1).End(xlDown)).Offset(, 3).Copy 'copy Amounts
Sheets("HG Invoice").Range("TaxInvAmount").PasteSpecial Paste:=xlPasteAllExceptBorders
Range(.Cells(1, 1), .Cells(1, 1).End(xlDown)).Offset(, 4).Copy 'copy Tax values
Sheets("HG Invoice").Range("TaxInvTax").PasteSpecial Paste:=xlPasteAllExceptBorders
'Else, if only one item in SaleDetails
Else: .Cells(1, 1).Copy 'copy Description
Sheets("HG Invoice").Range("TaxInvDescription").PasteSpecial Paste:=xlPasteAllExceptBorders
.Cells(1, 1).Offset(, 3).Copy 'copy Amount
Sheets("HG Invoice").Range("TaxInvAmount").PasteSpecial Paste:=xlPasteAllExceptBorders
.Cells(1, 1).Offset(, 4).Copy 'copy Tax value
Sheets("HG Invoice").Range("TaxInvTax").PasteSpecial Paste:=xlPasteAllExceptBorders
End If
End With
' EXPORT INVOICE AS PDF
Sheets("HG Invoice").Select
PDFFile = "C:\Users\HawkersGate Win7\Documents\" & "HGInv" & NewInv & " " & Customer & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' RESET SALE SHEET FOR NEW SALE
'Range("SaleDetails").ClearContents
'Sheets("Sale").Range("SaleTax").FormulaR1C1 = "=IF(RC[-1]<>0,ROUND(RC[-1]*0.1,2),"""")"
' REPROTECT Sheets
Sheets("Sale").Select
ActiveSheet.Protect
ActiveSheet.EnableSelection = xlUnlockedCells
Sheets("Sale Records").Select
ActiveSheet.Protect , AllowFiltering:=True
Sheets("HG Invoice").Select
ActiveSheet.Protect
Sheets("AR").Select
ActiveSheet.Protect
ActiveSheet.Protect , AllowFiltering:=True
'DETERMINE CELLAR INVOICE MONTH AND YEAR FROM INVOICE DATE & ASSUME IT WAS FROM LAST MONTH
InvMo = Format(DateAdd("m", -1, Sheets("Sale").Range("SaleDate").Value), "mmm")
InvYear = Format(DateAdd("m", -1, Sheets("Sale").Range("SaleDate").Value), "yy")
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = "Invoice " & NewInv & " from Hawkers Gate"
.To = CustEmail ' <-- Put email of the recipient here
.Body = "Latest invoice attached." & vbLf & vbLf _
& "Cheers," & vbLf _
& "James."
.attachments.Add PDFFile
If Dir("C:\Users\HawkersGate Win7\Documents\" & ClientCode & " " & InvMo & InvYear & ".xlsx") <> "" Then
.attachments.Add ("C:\Users\HawkersGate Win7\Documents\" & ClientCode & " " & InvMo & InvYear & ".xlsx")
End If
' Try to send
On Error Resume Next
'.Send 'THIS WILL SEND IMMEDIATELY
Application.Visible = True
.Display 'THIS WILL SEND LATER
End With
Set OutlApp = Nothing ' Release the memory of object variable
ErrorHandler:
If Err.Number = 1004 Then
MsgBox "Customer not found. Please set up new customer"
End If
Application.ScreenUpdating = True
End Sub