So.... I have an Invoice, the one I'm attaching is a very stripped-down version of the one I use. In VBA, Module2, the sub "Scan_CodeUpdated", I have received a great deal of assistance building it and I have been adding to it along the way. I want to say that it DOES work the way I want, I am curious if someone with much better coding skills can look at it and see what needs to be corrected to make it work most effeciently. I have hodge-podged it together from bits and pieces I have found from various sources and re-used from other code in the workbook, so I know ahead of time it will probably get some nasty sneers... :cool:... it is what it is. I am sure there has to be a more "gooder" (my wife hates when I say that word) way to work the code than what I have put together, for instance, there are several "End If"s at the end of the macro that shoud probably be put other places.... but that's why I am here...

Well, are you up for a challenge during a winter storm, (I am in south-central Kentucky, and forecast to be bombarded with snow and ice for the next couple of days or so...).

Click on my Logo in the upper-left to open the Scan_CodeUpdated sub.

To make it simple, I deleted all but the three "UPCs" I have been using while working on this, and I have simplified them, UPC # "1" is what I use to take a deposit payment (but it does not post to the "Customer Deposits" sheet until the invoice is finalized by pressing the "Next Invoice" button), UPC # "2" is to apply a pre-paid deposit (either in part or in whole, based on msgbox input and quantity of product # "3"), and UPC # "3" is the product I have been using, a "5 Frame Nuc Hive - Deep". I also have tiered pricing, so the price will change depending on the quantity of UPC # "3" ($185 for 1 or 2, $175 for 3 to 10, and $170 for 11 or more). There is also a "Gift Certificate" with an assigned # "4".

I have tested each of these and they all work on my end.

Now, hold your breath as you gaze upon this monstrosity of a work of code..... I apologize, I enjoy playing with this stuff but I'm trying to learn.

Thanks for your consideration and time!

Greg
Bee Lick Honey Co

Code:

Sub Scan_CodeUpdated()



 ' Created by Computer Man (419-355-0011) March 2024

 ' Updated by MrExcel.Com February(2025)

 

 '---------------------------------------------------------------------------------------------------'

 

 'In other places in VBA the original UPC-A barcode may be found, these are:

 

 ' "1" is "221283239905" this is used to accept a deposit,

 ' "2" is "221283240000" this is used to apply a pre-paid deposit to the purchase of product "3",

 ' "3" is "221283240222" this is a "5 Frame Nuc Hive - Deep".

 

 '---------------------------------------------------------------------------------------------------'

 



 Dim wsInvoice As Worksheet, wsDep As Worksheet, wsUPC As Worksheet, wsGC As Worksheet, sku As String, foundRng As Range

 Dim rowInvoice As Long, rowUPC As Variant, rowGC As Variant, gcRow As Variant

 Dim gcIssuedValue As Double, subtotal As Double, appliedGC As Double, remainingBalance As Double, currentUsed As Double

 Dim nucQty As Double, remainingDep As Double, appliedDep As Double, currentDep As Double

 Set wsInvoice = Worksheets("Invoice")

 Set wsUPC = Worksheets("UPC-SKU")

 Set wsGC = Worksheets("GC Register")

 Set wsDep = Worksheets("Customer Deposits")

 wsInvoice.Unprotect

 Rows("19:46").Hidden = False





Application.ScreenUpdating = True

10

Do

 sku = InputBox("Scan or Type Barcode Below", "UPC/SKU Input")



 If sku = """" Then Exit Do



Application.ScreenUpdating = False

If sku = "" Then GoTo 999











 

 Set foundRng = wsInvoice.Range("A13:A46").Find(sku, , , xlWhole)

 If Not foundRng Is Nothing Then

 rowInvoice = foundRng.row

 Else

 rowInvoice = wsInvoice.Cells(46, 1).End(xlUp).row + 1

 End If





 wsUPC.Unprotect



 rowUPC = Application.match(sku, wsUPC.Columns(1), 0)

 

 If Not IsError(rowUPC) Then

 If wsUPC.Cells(rowUPC, 5).value = 0 Then

 MsgBox "Out of stock!", vbOKOnly, "WARNING"

 

 Exit Do

 End If



 With wsInvoice

 .Cells(rowInvoice, "A").value = sku

 .Cells(rowInvoice, "B").Resize(1, 3).value = wsUPC.Cells(rowUPC, "B").Resize(1, 3).value

 .Cells(rowInvoice, "E").value = .Cells(rowInvoice, "E").value + 1

 End With

 

 'wsUPC.Cells(rowUPC, "E").value = wsUPC.Cells(rowUPC, "E").value - 1

 'wsUPC.Cells(rowUPC, "F").value = wsUPC.Cells(rowUPC, "F").value + 1

 

 

 If wsUPC.Cells(rowUPC, 5).value > 0 And wsUPC.Cells(rowUPC, 5).value < 10 Then

 MsgBox "Low Stock Alert" & vbCrLf & vbCrLf & "Qty Remaining: " & wsUPC.Cells(rowUPC, 5).value, vbOKOnly

 End If

 If sku = "1" Then GoTo 77

 If sku = "2" Then GoTo 88

 GoTo 10

 Exit Do

 End If



'Gift Certificate handling

 rowGC = Application.match(val(sku), wsGC.Columns(1), 0)

 If Not IsError(rowGC) Then

 subtotal = wsInvoice.Range("F47").value

 gcIssuedValue = wsGC.Cells(rowGC, "H").value

 remainingBalance = wsGC.Cells(rowGC, "J").value

 currentUsed = wsGC.Cells(rowGC, "I").value



 If IsEmpty(wsGC.Cells(rowGC, "I").value) And IsEmpty(wsGC.Cells(rowGC, "J").value) Then

 remainingBalance = gcIssuedValue

 appliedGC = Application.Min(gcIssuedValue, subtotal)

 ElseIf remainingBalance > 0 Then

 appliedGC = Application.Min(remainingBalance, subtotal)

 Else

 MsgBox "This Gift Card has no remaining balance and is now invalid.", vbOKOnly, "Invalid Gift Card"

 Exit Do

 End If



 wsInvoice.Cells(rowInvoice, "C").value = appliedGC

 End If



 With wsInvoice

 .Cells(rowInvoice, "A").value = sku

 .Cells(rowInvoice, "B").value = wsGC.Cells(rowGC, "B").value

 Application.ScreenUpdating = True

 End With



 'wsGC.Cells(rowGC, "H").value = wsGC.Cells(rowGC, "H").value + appliedGC

 'wsGC.Cells(rowGC, "I").value = wsGC.Cells(rowGC, "G").value - wsGC.Cells(rowGC, "H").value



 wsInvoice.Range("O11").value = appliedGC

 

 If wsGC.Cells(rowGC, "J").value <= 0 Then

 MsgBox "Gift Card Fully Used and Now Invalid!", vbOKOnly, "NOTICE"

 Exit Do

 End If



 Exit Do

 



 MsgBox "No Matching Gift Certificate Was Found.", vbOKOnly, "ERROR"



 

 Loop While Condition = True

 GoTo 10

 

' Clears the quantity when a Discount UPC is entered

 'If sku = "221283239912" _

 'Or sku = "221283239929" _

 'Or sku = "221283239936" _

 'Or sku = "221283239943" _

 'Or sku = "221283239950" _

 'Or sku = "221283239967" _

 'Or sku = "221283239974" _

 'Or sku = "221283239981" _

 'Or sku = "221283239998" Then

 'wsInvoice.Cells(rowInvoice, "E") = ""

 'End If







 

 

 'Create Prepaid Deposit

77

 If sku = "1" Then

 Add_Customer_Deposit.Show

 GoTo 999

 End If





 'Retreive Prepaid Deposit

Set wsInvoice = Worksheets("Invoice")

88



 If sku = "2" Then

Telephone = Application.InputBox("Enter Customer's Telephone Number", "CUSTOMER TELEPHONE #")

 If Telephone > "" Then

 Set fndDep = wsDep.Range("B:B").Find(Telephone, , , xlWhole)

 If Not fndDep Is Nothing Then

 rowDep = fndDep.row

 

 End If

 Dim rowTarget As Variant, rowTar As Variant, answer As Integer

 

 Set rowTar = wsInvoice.Range("A:A").Find("3", , , xlWhole)

 If Not rowTar Is Nothing Then

 rowTarget = rowTar.row

 If rowDep > "" Then

 End If

 

 answer = MsgBox("Apply Entire Deposit? (YES) OR Match Invoice Quantity? (NO)", _

 vbYesNo + vbQuestion, "SELECT DEPOSIT AMOUNT")

 

 

 nucQty = wsInvoice.Cells(rowTarget, "E")

 remainingDep = wsDep.Cells(rowDep, "D")

 appliedDep = Application.Min(nucQty, remainingDep)

 If answer = vbYes Then

123

 



 wsInvoice.Cells(rowInvoice, "E") = wsDep.Cells(rowDep, "D")

 'End If

 Else

 

 If answer = vbNo Then

 If wsInvoice.Cells(rowTarget, "E") >= wsDep.Cells(rowDep, "D") Then

 GoTo 12...

Excel Help Forum

Message History

Add new keyword

Delivery option(s)