Скачать с ютуб Expiry dates and inventory in Excel в хорошем качестве

Expiry dates and inventory in Excel

Expiry dates and inventory in Excel. Manage and organize you inventory relative the the expiry dates of the products. Free templates and templates with code are available for purchase for $50 USD https://www.easyexcelanswers.com/temp... Addition Templates may be available on request Click this link to check out my one-on-one training http://www.calendly.com/easyexcelanswers For more help visit my website www.easyexcelanswers.com or email me at [email protected]. Contact me regarding customizing this template for your needs. Click for online Excel Consulting http://www.calendly.com/easyexcelanswers I am able to provide online help on your computer at a reasonable rate. *this description may contain affiliate links. When you click them, I may receive a small commission at no extra cost to you. I only recommend products and services that I've used or have experience with. How to insert VBA code in Excel    • How to insert VBA code in Excel   Sub receive() Dim barcode As String Dim rng, rng1 As Range Dim rown, lrow As Long Dim qty As Long Dim erow, r As Long Dim found As Boolean: found = False Dim location As String 'barcode = Sheet1.Range("C7") location = Sheet1.Range("F7") If barcode = "" Then Exit Sub If barcode not equal "" And location = "" Then MsgBox "Location must be enter" Exit Sub End If If Range("location").Find(location, , Excel.xlValues) Is Nothing Then MsgBox "please enter valid location" Exit Sub End If qty = Sheet1.Range("F10") Sheet2.Activate Set rng = Sheet2.Columns("A:A").Find(what:=barcode, _ LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _ searchdirection:=xlNext, MatchCase:=False, SearchFormat:=False) ' send an error message if you do not find it If rng Is Nothing Then MsgBox "number not found" GoTo ende Else 'determine which row has the barcode rown = rng.Row If qty greater= 1 Then 'add the qty to the columns Sheet2.Cells(rown, 6).Value = Sheet2.Cells(rown, 6).Value + qty Sheet2.Cells(rown, 5).Value = Sheet2.Cells(rown, 5).Value + qty 'info to received Sheet6.Activate erow = Sheet6.Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheet6.Cells(erow, 1).Value = barcode Sheet6.Cells(erow, 2) = Sheet2.Cells(rown, 2).Value Sheet6.Cells(erow, 3).Value = qty Sheet6.Cells(erow, 4).Value = Sheet1.Range("F7").Value Sheet6.Cells(erow, 5).Value = Sheet1.Range("c10").Value Sheet6.Cells(erow, 6) = Date & " " & Time Sheet6.Cells(erow, 6).NumberFormat = "yyyy/mm/dd h:mm:ss AM/PM" Sheet6.Cells(erow, 7).Value = qty Sheet1.Activate GoTo ende End If If qty less 1 Then 'remove the qty to the columns Sheet2.Cells(rown, 7).Value = Sheet2.Cells(rown, 7).Value + Abs(qty) Sheet2.Cells(rown, 5).Value = Sheet2.Cells(rown, 5).Value + qty Sheet6.Activate r = 3 erow = Sheet6.Cells(Rows.Count, 1).End(xlUp).Row + 1 'remove the qty from the recive sheet For r = 3 To erow Sheet6.Cells(r, 1).Select 'check that you have the correct barcode and location If Sheet6.Cells(r, 1).Value = barcode And Sheet6.Cells(r, 4).Value = location Then Sheet6.Cells(r, 7).Value = Sheet6.Cells(r, 7).Value + qty Exit For End If Next r GoTo ende End If End If ende: Application.CutCopyMode = False Sheet1.Activate Sheet1.Range("c7").ClearContents Sheet1.Range("c10").ClearContents Sheet1.Range("f7").ClearContents Sheet1.Range("f10").ClearContents ActiveWorkbook.Sheets("Input").Activate Sheet1.Range("c7").Select '(and activate) End Sub Sub expiring() Dim r, erow As Long Dim lastrow As Long Dim explast As Long Dim expire As Date Sheet6.Activate 'delete what you have currenty in the soon to expire explast = Sheet6.Cells(Rows.Count, 10).End(xlUp).Row Range(Cells(6, 10), Cells(explast, 16)).ClearContents erow = Sheet6.Cells(Rows.Count, 1).End(xlUp).Row r = 3 For r = 3 To erow Sheet6.Cells(r, 7).Select 'delete any zero qty lines from receive list If ActiveCell.Value = 0 Then Range(Cells(r, 1), Cells(r, 7)).Delete Shift:=xlUp End If expire = Sheet6.Cells(r, 5).Value 'if the expire date on the items is less than 30 days from today If expire less Date + 30 Then 'copy the row to the soon to expire Range(Cells(r, 1), Cells(r, 7)).Copy lastrow = Sheet6.Cells(Rows.Count, 10).End(xlUp).Row + 1 Cells(lastrow, 10).PasteSpecial GoTo ende End If ende: Next r Application.CutCopyMode = False End Sub