Messaggio se il valore inserito in una cella é errato

[RaeleaR]

Salve a tutti,
ho un foglio con delle colonne contenenti alcuni valori. L'ultima colonna("G8:G" & UR), dopo quelle piene, é lasciata libera perché l'Utente inserisca dei dati di vendita. Nella colonna immediatamente precedente a questa("F8:F" & UR) ci sono le quantitá disponibili per articolo.
Vorrei che, se il valore che immette l'Utente in una cella della colonna("G...) "Q.tá Venduta" é superiore alla corrispondente ("F...)"Q.tá Disponibile", appaia un messaggio di informazione che invita a correggere il dato e pulisca la cella con il dato errato.
Ho pensato di utilizzare il Worksheet_Change(ByVal Target As Range) ed ho scritto:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Intervallo As Range, UR As Long
Dim Res As VbMsgBoxResult

If Target.Count > 1 Then 'scateno l'evento solo quando
Exit Sub 'viene modificata una sola cella
End If
UR = Range("G" & Rows.Count).End(xlUp).Row


Set Intervallo = Range("B8:B" & UR) 'Inserisco il mio intervallo

If Intersect(Target, Intervallo) _
Is Nothing Then 'Se la cella selezionata é vuota

Application.EnableEvents = False 'Inibisco gli eventi

If Not Intersect(Target, Intervallo).Value <= _
Target.Offset(0, -1).Value Then
Res = MsgBox(Prompt:="Quantitá inserita non valida!" _
& vbNewLine _
& vbNewLine _
& "La quantitá venduta non puó essere maggiore della disponibile.", _
Buttons:=vbExclamation, Title:="")
Intersect(Target, Intervallo).Value = ""
End If

Application.EnableEvents = True
End If
End Sub

Peró se provo a scrivere 5 (ad esempio) lí dove il valore nell'Offset(0, - 1) é 3, non accade nulla.. Che cosa sto sbagliando?
Qualcuno puó aiutarmi?

[Anthony47]

Nel tuo messaggio parli di colonna G compilata dall' utente e colonna F contenente la quantita' disponibile; poi misteriosamente vai a controllare se l' utente ha scritto qualcosa in colonna B... Non meravigliarti quindi che la macro non interviene...
Altra incongruenza, calcoli UR (ultima riga, I presume) sulla base della stessa colonna G (in cui dovresti scrivere), col risultato che una scrittura "sotto" l' ultima cella di colonna G gia' compilata sarebbe ignorata dal codice successivo.
Supponendo che sia corretta la descrizione data (colonna G da compilare, colonna F con le giacenze) il codice corretto potrebbe essere questo:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Intervallo As Range, UR As Long
Dim Res As VbMsgBoxResult
'
If Target.Count > 1 Then 'scateno l'evento solo quando
    Exit Sub 'viene modificata una sola cella
End If
UR = Range("F" & Rows.Count).End(xlUp).Row      'UR calcolato su colonna F
Set Intervallo = Range("G8:G" & UR) 'Inserisco il mio intervallo
'
If Not Intersect(Target, Intervallo) Is Nothing Then 'Se viene compilata una cella "dati di vendita"
    Application.EnableEvents = False 'Inibisco gli eventi
    If Target.Value > Target.Offset(0, -1).Value Then
        Res = MsgBox(Prompt:="Quantitá inserita in " & Target.Address & " non valida! (" & Target.Value & ")" _
        & vbNewLine _
        & vbNewLine _
        & "La quantitá venduta non puó essere maggiore della disponibile.", _
        Buttons:=vbExclamation, Title:="")
        Target.Value = ""
        Target.Select
    End If
    Application.EnableEvents = True
End If
End Sub


Questa versione pero' non impedisce a qualche "volenteroso guastatore" di copiare piu' valori errati e incollarli contemporaneamente in colonna G.
Suggerisco pertanto questa versione che lavora anche su selezioni multiple:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Intervallo As Range, UR As Long, Cell As Range
Dim Res As VbMsgBoxResult, myErr As String
'
UR = Range("F" & Rows.Count).End(xlUp).Row      'UR calcolato su colonna F
Set Intervallo = Range("G8:G" & UR) 'Inserisco il mio intervallo
'
If Not Intersect(Target, Intervallo) Is Nothing Then 'Se viene compilata una cella "dati di vendita"
    Application.EnableEvents = False 'Inibisco gli eventi

    For Each Cell In Intersect(Target, Intervallo)
        If Cell.Value > Cell.Offset(0, -1).Value Then
            myErr = myErr & Cell.Address(0, 0) & "; "
            Cell.ClearContents
        End If
    Next Cell
End If
If Len(myErr) > 2 Then
    myErr = Left(myErr, Len(myErr) - 1)
    Res = MsgBox("Le seguenti celle sono state compilate con un valore superiore alla quantita' disponibile:" _
        & vbCrLf & Left(myErr, Len(myErr) - 1) _
        & vbCrLf & "Reintrodurre valori corretti", vbExclamation)
End If
Application.EnableEvents = True
End Sub

Ciao

[RaeleaR]

Chiedo scusa per le incongruenze, una l'avevo riscontrata dopo aver postato ed ho mancato di reinviare il post corretto.. Grazie Anthony per avermi fatto notare gli errori..
Mi metto a studiare le tue proposte e ritorno con le idee piú chiare.
Grazie ancora per il contributo

[RaeleaR]

Ciao Anthony,
ho imparato qualcosa di nuovo.
Grazie