only allow 1 or 2 in a cell range / date

Trevor3007

Trevor3007

Well-known Member
Joined
Jan 26, 2017
Messages
667
Office Version
  1. 365
Platform
  1. Windows
test_servey.xlsm
ABCDEFGHIJKL
5WingFloorDeskDockUSB3K/BMouseMonitorHDMI/DVIDVI/DVINote / CommentsDate
61111111Full Kit
72222222No Kit
81211121Part Kit
Site Survey
Cells with Data Validation
CellAllowCriteria
K6:K8List=DropDown!$A$2:$A$4



Good evening,

I have 3 issues:-

1) in the cells that have 1 or a 2, i want to force the user only to use 1 or 2 in the respective area (d6-j999 .and should the user not use 1 or 2 in the respective cells, a popup message will appear stating the fact .
2+3) in the date which MUST be entered when , can the date be triggered so when there is data in the range k6-k999.
I cannot use ()now as it will change the date each each day. So can it be done so the date will automatically enter, but not change when the 'system' date does?

The above is well out of my scope & therefore reaching out to Mr Excel for help.

Thank you for your assistance with my issue.
 
Last edited:

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
For the tasks that you want to see automated, we use the Worksheet_Change procedure. The Worksheet_Change procedure is a so called event procedure and will be executed automatically by Excel when such a change event on that particular worksheet occurs.
The code below goes into a worksheet module, more specific: the module of the worksheet to be affected. Activate that sheet, right click on its tab and click View Code. The VBE will open with the right code module active on the main (right hand) pane. VBE's title bar will confirm wether you've opened the correct code module, see attached image.
Pressing CTRL-R opens the Project Explorer, the left hand pane on the image. Paste the code below in the right hand pane and see if this works for you.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Const BINARY_RANGE      As String = "D6:J999"
    Const COMMENTS_RANGE    As String = "K6:K999"

    Const PLACEHOLDER       As String = "$@#@$"
    Const MESSAGE           As String = "Cell $@#@$ requires a 1 or a 2 as input!"
    
    Dim Act As Boolean
    Dim c   As Range
    
    Application.EnableEvents = False
    For Each c In Target
        Act = False
        If Not Application.Intersect(c, Range(BINARY_RANGE)) Is Nothing Then
            If IsError(c.Value) Then
                Act = True
            Else
                If c.Value <> 1 And c.Value <> 2 Then
                    Act = True
                End If
            End If
            If Act Then
                c.Value = vbNullString
                MsgBox Replace(MESSAGE, PLACEHOLDER, c.Address)
            End If
        End If
    Next c
    For Each c In Target
        If Not Application.Intersect(c, Range(COMMENTS_RANGE)) Is Nothing Then
            If IsError(c.Value) Then
                c.Offset(0, 1).Value = vbNullString
            Else
                If Len(c.Value) = 0 Then
                    c.Offset(0, 1).Value = vbNullString
                Else
                    c.Offset(0, 1).Value = Date
                End If
            End If
        End If
    Next c
    Application.EnableEvents = True
End Sub
 

Attachments

  • ScreenShot180.jpg
    ScreenShot180.jpg
    77.6 KB · Views: 4
Upvote 0
GWteB said:
For the tasks that you want to see automated, we use the Worksheet_Change procedure. The Worksheet_Change procedure is a so called event procedure and will be executed automatically by Excel when such a change event on that particular worksheet occurs.
The code below goes into a worksheet module, more specific: the module of the worksheet to be affected. Activate that sheet, right click on its tab and click View Code. The VBE will open with the right code module active on the main (right hand) pane. VBE's title bar will confirm wether you've opened the correct code module, see attached image.
Pressing CTRL-R opens the Project Explorer, the left hand pane on the image. Paste the code below in the right hand pane and see if this works for you.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Const BINARY_RANGE      As String = "D6:J999"
    Const COMMENTS_RANGE    As String = "K6:K999"

    Const PLACEHOLDER       As String = "$@#@$"
    Const MESSAGE           As String = "Cell $@#@$ requires a 1 or a 2 as input!"
   
    Dim Act As Boolean
    Dim c   As Range
   
    Application.EnableEvents = False
    For Each c In Target
        Act = False
        If Not Application.Intersect(c, Range(BINARY_RANGE)) Is Nothing Then
            If IsError(c.Value) Then
                Act = True
            Else
                If c.Value <> 1 And c.Value <> 2 Then
                    Act = True
                End If
            End If
            If Act Then
                c.Value = vbNullString
                MsgBox Replace(MESSAGE, PLACEHOLDER, c.Address)
            End If
        End If
    Next c
    For Each c In Target
        If Not Application.Intersect(c, Range(COMMENTS_RANGE)) Is Nothing Then
            If IsError(c.Value) Then
                c.Offset(0, 1).Value = vbNullString
            Else
                If Len(c.Value) = 0 Then
                    c.Offset(0, 1).Value = vbNullString
                Else
                    c.Offset(0, 1).Value = Date
                End If
            End If
        End If
    Next c
    Application.EnableEvents = True
End Sub
Click to expand...
WOW... FAN TAS TIC.....

works perfectly... THANK YOU.

Have a great rest of your day.
 
Upvote 0
You are welcome and thanks for letting me know.
 
Upvote 0
GWteB said:
For the tasks that you want to see automated, we use the Worksheet_Change procedure. The Worksheet_Change procedure is a so called event procedure and will be executed automatically by Excel when such a change event on that particular worksheet occurs.
The code below goes into a worksheet module, more specific: the module of the worksheet to be affected. Activate that sheet, right click on its tab and click View Code. The VBE will open with the right code module active on the main (right hand) pane. VBE's title bar will confirm wether you've opened the correct code module, see attached image.
Pressing CTRL-R opens the Project Explorer, the left hand pane on the image. Paste the code below in the right hand pane and see if this works for you.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Const BINARY_RANGE      As String = "D6:J999"
    Const COMMENTS_RANGE    As String = "K6:K999"

    Const PLACEHOLDER       As String = "$@#@$"
    Const MESSAGE           As String = "Cell $@#@$ requires a 1 or a 2 as input!"
   
    Dim Act As Boolean
    Dim c   As Range
   
    Application.EnableEvents = False
    For Each c In Target
        Act = False
        If Not Application.Intersect(c, Range(BINARY_RANGE)) Is Nothing Then
            If IsError(c.Value) Then
                Act = True
            Else
                If c.Value <> 1 And c.Value <> 2 Then
                    Act = True
                End If
            End If
            If Act Then
                c.Value = vbNullString
                MsgBox Replace(MESSAGE, PLACEHOLDER, c.Address)
            End If
        End If
    Next c
    For Each c In Target
        If Not Application.Intersect(c, Range(COMMENTS_RANGE)) Is Nothing Then
            If IsError(c.Value) Then
                c.Offset(0, 1).Value = vbNullString
            Else
                If Len(c.Value) = 0 Then
                    c.Offset(0, 1).Value = vbNullString
                Else
                    c.Offset(0, 1).Value = Date
                End If
            End If
        End If
    Next c
    Application.EnableEvents = True
End Sub
Click to expand...
Hi,


So rorry to ask...but if i select multi rows , i get the error ( please attached) . Are you able to sort please?

Many thanks.
 

Attachments

  • error.jpg
    error.jpg
    210.5 KB · Views: 2
Upvote 0
The code does as requested:
Trevor3007 said:
i want to force the user only to use 1 or 2 in the respective area (d6-j999 .and should the user not use 1 or 2 in the respective cells, a popup message will appear stating the fact
Click to expand...

The message is not an error, it's a message generated by the code, after all, your wish was to only allow input of 1 or 2.
I understand that you may want to be able to copy empty cells multiple times within this range. The following modification of the code of post #2 ensures that the contents of a cell can also be deleted. This has the effect that you can also copy an empty cell by dragging. Paste the red and green line into your current code as per below. Let me know if this suits your needs or if you had something else in mind.
Rich (BB code): 
            If IsError(c.Value) Then
                Act = True
            ElseIf c.Value = vbNullString Then
                ' do nothing
            Else
                If c.Value <> 1 And c.Value <> 2 Then
                    Act = True
                End If
            End If
 
Upvote 0
GWteB said:
The code does as requested:


The message is not an error, it's a message generated by the code, after all, your wish was to only allow input of 1 or 2.
I understand that you may want to be able to copy empty cells multiple times within this range. The following modification of the code of post #2 ensures that the contents of a cell can also be deleted. This has the effect that you can also copy an empty cell by dragging. Paste the red and green line into your current code as per below. Let me know if this suits your needs or if you had something else in mind.
Rich (BB code): 
            If IsError(c.Value) Then
                Act = True
            ElseIf c.Value = vbNullString Then
                ' do nothing
            Else
                If c.Value <> 1 And c.Value <> 2 Then
                    Act = True
                End If
            End If
Click to expand...
thank you..

i am lost as to where to insert your great code,
would you mind inserting into

VBA Code: 
    Const BINARY_RANGE      As String = "d6:J999"
    Const COMMENTS_RANGE    As String = "K6:K999"

    Const PLACEHOLDER       As String = "$@#@$"
    Const MESSAGE           As String = "Cell $@#@$ Only 1 Is Allowed!"
    
    Dim Act As Boolean
    Dim c   As Range
    
    Application.EnableEvents = False
    For Each c In Target
        Act = False
        If Not Application.Intersect(c, Range(BINARY_RANGE)) Is Nothing Then
            If IsError(c.Value) Then
                Act = True
            Else
                If c.Value <> 0 And c.Value <> 1 Then
                    Act = True
                End If
            End If
            If Act Then
                c.Value = vbNullString
                MsgBox Replace(MESSAGE, PLACEHOLDER, c.Address)
            End If
        End If
    Next c
    For Each c In Target
        If Not Application.Intersect(c, Range(COMMENTS_RANGE)) Is Nothing Then
            If IsError(c.Value) Then
                c.Offset(0, 1).Value = vbNullString
            Else
                If Len(c.Value) = 0 Then
                    c.Offset(0, 1).Value = vbNullString
                Else
                    c.Offset(0, 1).Value = Date
                End If
            End If
        End If
    Next c
    Application.EnableEvents = True


Much appreciate your help.
 
Upvote 0
I see, it's supposed to go in here ...

Rich (BB code): 
    Const BINARY_RANGE      As String = "d6:J999"
    Const COMMENTS_RANGE    As String = "K6:K999"

    Const PLACEHOLDER       As String = "$@#@$"
    Const MESSAGE           As String = "Cell $@#@$ Only 1 Is Allowed!"
    
    Dim Act As Boolean
    Dim c   As Range
    
    Application.EnableEvents = False
    For Each c In Target
        Act = False
        If Not Application.Intersect(c, Range(BINARY_RANGE)) Is Nothing Then
            If IsError(c.Value) Then
                Act = True
            ElseIf c.Value = vbNullString Then
                ' do nothing
            Else
                If c.Value <> 0 And c.Value <> 1 Then
                    Act = True
                End If
            End If
            If Act Then
                c.Value = vbNullString
                MsgBox Replace(MESSAGE, PLACEHOLDER, c.Address)
            End If
        End If
    Next c
    For Each c In Target
        If Not Application.Intersect(c, Range(COMMENTS_RANGE)) Is Nothing Then
            If IsError(c.Value) Then
                c.Offset(0, 1).Value = vbNullString
            Else
                If Len(c.Value) = 0 Then
                    c.Offset(0, 1).Value = vbNullString
                Else
                    c.Offset(0, 1).Value = Date
                End If
            End If
        End If
    Next c
    Application.EnableEvents = True
 
Upvote 0
Solution
thanks .. that works great.

have good day & best wishes too.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
trying to use only 1 formula to populate the information in various columns which are not adjacent to each other.
Replies
3
Views
118
noaman79
N
AndyTampa
  • Solved
InputBox to ask for date and only accept standard date formats
2 3
Replies
27
Views
1K
AndyTampa
AndyTampa
B
  • Solved
VBA solution for a tally sheet, add 1 to a cell based on current date
2
Replies
10
Views
147
Burrgogi
B
L
  • Solved
Returning a date in a cell, but leave blank if no date entered
Replies
8
Views
318
Peter_SSs
Peter_SSs
G
  • Solved
History of Dates to be traced in Excel (2010) in DD/MM/YYYY format
2
Replies
11
Views
428
MARK858
MARK858

Forum statistics

Threads
1,215,506
Messages
6,125,189
Members
449,213
Latest member
Kirbito

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top