Error message if value is noth within range

[vonrainer]

Hello,

I would like to make a macro (Workbook_SheetChange) to display an error message if the value entered is not within a range of 1000000 and 3999999.
I already have code to display error message if the entered value already exists in the worksheet

How can I set this up?

[Kaper]

Add another test to the code you already have. The test will be probably (but it depends on the code you already have):

if target.value<1000000  or target.value> 3999999 then msgbox "Value out of range"

[vonrainer]

Adding this gave me an error.

Below is the code i currently have:

Option Explicit


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
    'Define your variables.
    Dim ws As Worksheet, EvalRange As Range
    
    'Set the range where you want to prevent duplicate entries.
    Set EvalRange = Range("A1:A60")
    
    'If the value entered already exists in the defined range on the current worksheet, throw an
    'error message and undo the entry.
    If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then
        MsgBox Target.Value & " - the bilagsnr already exists on this sheet."
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    End If
    
    'Check the other worksheets in the workbook.
    For Each ws In Worksheets
        With ws
            If .Name <> Target.Parent.Name Then
                'If the value entered already exists in the defined range on the current worksheet, throw an
                'error message and undo the entry.
                If WorksheetFunction.CountIf(Sheets(.Name).Range("A1:A999"), Target.Value) > 0 Then
                    MsgBox Target.Value & " - bilagsnr already exists on the sheet named " & .Name & ".", _
                    16, "Duplicate found!"
                    Application.EnableEvents = False
                    Application.Undo
                    Application.EnableEvents = True
                    Exit For
                End If
            End If
        End With
    Next ws
End Sub

Where should I add the new code?

[Kaper]

How about adding it at the beginning :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
    'Define your variables.
    Dim ws As Worksheet, EvalRange As Range
    
    'Set the range where you want to prevent duplicate entries.
    Set EvalRange = Range("A1:A60")

    if target.value<1000000  or target.value> 3999999 then msgbox "Value out of range"

'or similarily to duplicate also undo

'    if target.value<1000000  or target.value> 3999999 then 
'        MsgBox Target.Value & " out of allowed range"
'        Application.EnableEvents = False
'        Application.Undo
'        Application.EnableEvents = True
'    End If


    'If the value entered already exists in the defined range on the current worksheet, throw an
    'error message and undo the entry.
    If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then
        MsgBox Target.Value & " - the bilagsnr already exists on this sheet."
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    End If
'...

By the way - why not use just data validation in the spreadsheet?