Ok, here it is. If you need help or have any problems, just lemme
know...
Option Explicit
'********************************************************************
'COPY THE SECTION BELOW INTO THE WORKSHEET THAT HAS YOUR NAMED CELLS
'THEN REMOVE THE '
'********************************************************************
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
' VerifyPricing
'
'End Sub
'********************************************************************
'COPY ALL OF THE REST OF THIS INTO A NEW MODULE IN YOUR WORKBOOK
'HOPEFULLY I HAVE GIVEN ENOUGH INFO IN THE COMMENTS FOR YOU TO BE
'ABLE TO MAKE THIS WORK THE WAY YOU WANT.
'********************************************************************
Public Const Limit = 2499
'Change this value if you want to alter
'your preset value for an acceptable
'amount in the TARGET(pricing?) cell.
Public Const Minimum = 0
'Change this value to change what minimum
'value Qty must contain in order to allow
'an entry into the TARGET(pricing?) cell.
Public Const BidCell = "AUDIT"
'Change this value in order to Change how
'the TARGET(pricing?) cell is referred to
'in the warning messages.
Public Const MinCell = "QTY"
'Change this value in order to Change how
'the QTY(Minimum?) cell is referred
'to in the warning messages.
Public QTY As Range 'Defined in the VerifyPricing Procedure
'If you want to change the names of
Public AUDIT As Range 'cells on your spreadsheet, you must change
'these as well(within VerifyPricing).
'--------------------------------------------------------------------
Enum WarningTypes
wtExceedMax = 0 'USED BY THE ISSUEWARNING
wtInvalidQty = 1 'PROCEDURE
End Enum
'--------------------------------------------------------------------
' VERIFYPRICING PROCEDURE
'--------------------------------------------------------------------
Sub VerifyPricing()
Set QTY = Range("QTY") 'If you change the name of the
'cell "QTY" in your spreadsheet,
'then you must change the name
'between the quotes in this
'variable. This applies for
'the "TARGET" cell as well.
Set AUDIT = Range("AUDIT")
' PROCEDURE BODY
On Error Resume Next
Select Case AUDIT
Case Is < Limit
AUDIT.Comment.Delete
Case Is > Limit
If QTY <> 0 Then
IssueWarning AUDIT, wtExceedMax
End If
End Select
Select Case QTY
Case Is = 0
If AUDIT <> 0 Then
IssueWarning AUDIT, wtInvalidQty
End If
End Select
End Sub
Sub IssueWarning(Destination As Range, Warning As WarningTypes)
Select Case Warning
Case wtExceedMax
With Destination
.AddComment
.Comment.Visible = True
.Comment.Text Text:="The amount entered " & _
"here exceeds a preset limit. " & _
"For auditing purposes, make sure to file" & _
"form ""XYZ..."""
End With
Beep
Case wtInvalidQty
Destination.ClearContents
MsgBox "The value in " & MinCell & " must be " & _
"greater than " & Minimum & " in " & _
vbCrLf & "order for an entry to be allowed " & _
"in the " & BidCell & " cell!", vbExclamation
QTY.Select
End Select
End Sub
