vba macro to restrict mobile number entry in a cell range

P

Prasad K

Board Regular
Joined
Aug 4, 2021
Messages
189
Office Version
  1. 2016
  2. 2007
Platform
  1. Windows
I want a vba macro to restrict mobile number entry in a cell range like if I type 10 digits mobile number in a cell range of column B & it will accept the 10 digit mobile number entry

If I type less than or greater than 10 digits number in a cell range then it will show me a message with popup window

MsgBox (Please check the number you have Enter The Mobile should be contain 10 Digits only)

And one more if I enter same mobile number in a cell range then it will show me a message with popup MsgBox (You have Entered the Mobile Number is Already Exist in cell B4 , you want to continue with Duplicate Mobile Number click YES (or) want to remove Duplicate Mobile Number in EnireRow click NO)




Book1
AB
1Customer NameCustomer Mobile Number
2Ajay Kumar8521479630
3Arun Prasad2587413694
4Vikram Shah6222017896
5Govind Patel6321478952
6Ashok Kumar5467983120
7Sujatha Reddy5214639874
8Aparna Kumar7531598462
9Arjun Prasad Rao6899451124
10Vikram Shah6222017896
Sheet1
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Try

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

If Not Intersect(Target, Range("B2:B10")) Is Nothing Then
If Len(Target.Cells) > 10 Then MsgBox "Please check the number you have Enter The Mobile should be contain 10 Digits only"

End If
End Sub
 
Upvote 0
This is for both greater then or less then 10 digits

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

If Not Intersect(Target, Range("B2:B10")) Is Nothing Then
If Len(Target.Cells) > 10 Or Len(Target.Cells) < 10 Then MsgBox "Please check the number you have Enter The Mobile should be contain 10 Digits only"

End If
End Sub
 
Upvote 0
hrayani said:
This is for both greater then or less then 10 digits

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

If Not Intersect(Target, Range("B2:B10")) Is Nothing Then
If Len(Target.Cells) > 10 Or Len(Target.Cells) < 10 Then MsgBox "Please check the number you have Enter The Mobile should be contain 10 Digits only"

End If
End Sub
Click to expand...
Ok for duplicate mobile number entry also i want
 
Upvote 0
Sorry I missed the last part

Try this then

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

Dim answer As Integer

If Not Intersect(Target, Range("B2:B10")) Is Nothing Then
If Len(Target.Cells) > 10 Or Len(Target.Cells) < 10 Then MsgBox "Please check the number you have Enter The Mobile should be contain 10 Digits only"
If Application.CountIf(Columns(2), Target.Cells.Value) > 1 Then answer = MsgBox("You have Entered the Mobile Number is Already Exist in cell" & vbNewLine & "If you want to continue with Duplicate Mobile Number click (YES)" & vbNewLine & "If want to remove Duplicate Mobile Number in EnireRow click (NO)", vbQuestion + vbYesNo + vbDefaultButton2, "Duplicate Entry")

If answer = vbNo Then Target.Cells.ClearContents
    
End If
End Sub
 
Upvote 0
hrayani said:
Sorry I missed the last part

Try this then

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

Dim answer As Integer

If Not Intersect(Target, Range("B2:B10")) Is Nothing Then
If Len(Target.Cells) > 10 Or Len(Target.Cells) < 10 Then MsgBox "Please check the number you have Enter The Mobile should be contain 10 Digits only"
If Application.CountIf(Columns(2), Target.Cells.Value) > 1 Then answer = MsgBox("You have Entered the Mobile Number is Already Exist in cell" & vbNewLine & "If you want to continue with Duplicate Mobile Number click (YES)" & vbNewLine & "If want to remove Duplicate Mobile Number in EnireRow click (NO)", vbQuestion + vbYesNo + vbDefaultButton2, "Duplicate Entry")

If answer = vbNo Then Target.Cells.ClearContents
  
End If
End Sub
Click to expand...
Thank you this code is working

and here is this code not removing duplicate number in entire row just removing only in mobile number cell and one more thing in second msgbox it will not showing cell value of already existing mobile number in which cell like

if i type same mobile number in that cell range it will show me in second msgbox like this You have Entered the Mobile Number is Already Exist in cell B4

and one more thing change cell range to entire column like in this cell range B2:B10 change to entire column
 

Attachments

  • Capture1.PNG
    Capture1.PNG
    48.1 KB · Views: 11
Upvote 0
This will delete mobile number as well as the name in column A

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

Dim answer As Integer

If Not Intersect(Target, Range("B2:B10")) Is Nothing Then

If Len(Target.Cells) > 10 Or Len(Target.Cells) < 10 Then MsgBox _
    "Please check the number you have Enter The Mobile should be contain 10 Digits only"

If Application.CountIf(Columns(2), Target.Cells.Value) > 1 Then
    answer = MsgBox("You have Entered the Mobile Number is Already Exist in cell" _
        & vbNewLine & "If you want to continue with Duplicate Mobile Number click (YES)" _
            & vbNewLine & "If want to remove Duplicate Mobile Number in EnireRow click (NO)", _
                vbQuestion + vbYesNo + vbDefaultButton2, "Duplicate Entry")

If answer = vbNo Then
Target.Cells.Offset(0, -1).ClearContents
Target.Cells.ClearContents


End If
    End If
        End If
    
End Sub

Regarding other requirements... I do not know how to do that

some expert here might be able to help
 
Upvote 0
hrayani said:
This will delete mobile number as well as the name in column A

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

Dim answer As Integer

If Not Intersect(Target, Range("B2:B10")) Is Nothing Then

If Len(Target.Cells) > 10 Or Len(Target.Cells) < 10 Then MsgBox _
    "Please check the number you have Enter The Mobile should be contain 10 Digits only"

If Application.CountIf(Columns(2), Target.Cells.Value) > 1 Then
    answer = MsgBox("You have Entered the Mobile Number is Already Exist in cell" _
        & vbNewLine & "If you want to continue with Duplicate Mobile Number click (YES)" _
            & vbNewLine & "If want to remove Duplicate Mobile Number in EnireRow click (NO)", _
                vbQuestion + vbYesNo + vbDefaultButton2, "Duplicate Entry")

If answer = vbNo Then
Target.Cells.Offset(0, -1).ClearContents
Target.Cells.ClearContents


End If
    End If
        End If
   
End Sub

Regarding other requirements... I do not know how to do that

some expert here might be able to help
Click to expand...
Thank for helping again & it's not showing of cell value of already mobile number exists

you have telling i do not know how to do that ok i will wait for another reply from any expert in mrexcel
 
Upvote 0
Prasad K said:
Thank for helping again & it's not showing of cell value of already mobile number exists

you have telling i do not know how to do that ok i will wait for another reply from any expert in mrexcel
Click to expand...
Changed the code to little bit knowledge i have

Now any one expert in mrexcel change this code has per my required like below details

In second msgbox it will not showing cell value of already existing mobile number in which cell like

if i type same mobile number in that cell range it will show me in second msgbox like this (You have Entered the Mobile Number is Already Exist in cell B4)


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

Dim answer As Integer

If Not Intersect(Target, Range("B:B")) Is Nothing Then
On Error Resume Next
If Len(Target.Cells) > 10 Or Len(Target.Cells) < 10 Then MsgBox _
    "Please check the number you have Enter The Mobile should be contain 10 Digits only"

If Application.CountIf(Columns(2), Target.Cells.Value) > 1 Then
    answer = MsgBox("You have Entered the Mobile Number is Already Exist in cell" _
        & vbNewLine & "If you want to continue with Duplicate Mobile Number click (YES)" _
            & vbNewLine & "If want to remove Duplicate Mobile Number in EnireRow click (NO)", _
                vbQuestion + vbYesNo + vbDefaultButton2, "Duplicate Entry")

If answer = vbNo Then
Target.Cells.EntireRow.Delete

End If
    End If
        End If
    
End Sub
 
Upvote 0
Prasad K said:
Changed the code to little bit knowledge i have

Now any one expert in mrexcel change this code has per my required like below details

In second msgbox it will not showing cell value of already existing mobile number in which cell like

if i type same mobile number in that cell range it will show me in second msgbox like this (You have Entered the Mobile Number is Already Exist in cell B4)


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

Dim answer As Integer

If Not Intersect(Target, Range("B:B")) Is Nothing Then
On Error Resume Next
If Len(Target.Cells) > 10 Or Len(Target.Cells) < 10 Then MsgBox _
    "Please check the number you have Enter The Mobile should be contain 10 Digits only"

If Application.CountIf(Columns(2), Target.Cells.Value) > 1 Then
    answer = MsgBox("You have Entered the Mobile Number is Already Exist in cell" _
        & vbNewLine & "If you want to continue with Duplicate Mobile Number click (YES)" _
            & vbNewLine & "If want to remove Duplicate Mobile Number in EnireRow click (NO)", _
                vbQuestion + vbYesNo + vbDefaultButton2, "Duplicate Entry")

If answer = vbNo Then
Target.Cells.EntireRow.Delete

End If
    End If
        End If
   
End Sub
Click to expand...
Any one is in online to help
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question
Can scripting dictionary alert if certain criteria are met?
Replies
1
Views
164
Lil Stinker
L
M
  • Question
Help with VBA code when selecting next sheet in workbook
Replies
3
Views
236
StephenCrump
S
J
  • Question
Excel VBA Help
2
Replies
16
Views
556
justincaza
J
T
  • Question
Macro to quickly check compliance breaches.
Replies
0
Views
304
Tezzadactyl
T
J
  • Question
Excel to Whatsapp message
Replies
1
Views
4K
MCLIFTO8
MCLIFTO8

Forum statistics

Threads
1,216,085
Messages
6,128,732
Members
449,465
Latest member
TAKLAM

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