HERE I WANT A SMALL CHANGE IN THIS CODE AGAIN

P

Prasad K

Board Regular
Joined
Aug 4, 2021
Messages
189
Office Version
  1. 2016
  2. 2007
Platform
  1. Windows
this code is working well to me on my work & here i want a small change in this code any excel experts will solve this

when i am typing any unique mobile number in column B then it will showing me in msgbox Duplicate Entry & here this msgbox is correct when i type any duplicate mobile number in column B then only it will show msgbox Duplicate Entry & here is problem with this code if i type unique mobile number then also it will showing msgbox Duplicate Entry & here my request is the Msgbox will be show Duplicate Entry on if i type Duplicate Mobile number only not on Unique mobile number entry

And one more request

when i am typing 2 or 3 mobile numbers in a cell of column B with adding any special character in middle of every mobile number in that cell then also i will getting msgbox please check the number & deleting the numbers in that cell & here this msgbox also correct when if i type mobile number more than or less than 10 digits then only this msgbox will come

here my request is if i type 2 or 3 or how any mobile numbers its have it should accept with any msgbox showing





VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 With Application
 On Error Resume Next
   If Not Intersect(Target, Range("B1:B1000")) Is Nothing And Target.Count = 1 And Len(Target) <> 10 Then
       .EnableEvents = False
        MsgBox "Please check the number you have Enter The Mobile should be contain 10 Digits only"
       .Undo
       .EnableEvents = True
       Exit Sub
   Else
       a = Application.Match(Target.Value, Range("B1:B1000"), 0)
       If IsNumeric(a) Then
           If MsgBox("You have Entered the Mobile Number is Already Exist in cell " & Cells(a, 2).Address(0, 0) & 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") = vbNo Then
              Target.Cells.EntireRow.Delete
              .EnableEvents = False
              .Undo
              .EnableEvents = True
           End If
       End If
   End If
 End With
End Sub
 

Attachments

  • D1.JPG
    D1.JPG
    74.3 KB · Views: 13
  • D2.JPG
    D2.JPG
    72.7 KB · Views: 13

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
Prasad K said:
when i am typing 2 or 3 mobile numbers in a cell of column B with adding any special character in middle of every mobile number in that cell then also i will getting msgbox please check the number & deleting the numbers in that cell & here this msgbox also correct when if i type mobile number more than or less than 10 digits then only this msgbox will come

here my request is if i type 2 or 3 or how any mobile numbers its have it should accept with any msgbox showing
Click to expand...
You can put a couple of examples of what you want to capture in a cell and that it is valid for you.
That is to say:
a1234, 2345 is correct or incorrect?
1245782356, 1245788922 is correct or incorrect?
1245782356, bb45788922 is correct or incorrect?
 
Upvote 0
DanteAmor said:
You can put a couple of examples of what you want to capture in a cell and that it is valid for you.
That is to say:
a1234, 2345 is correct or incorrect?
1245782356, 1245788922 is correct or incorrect?
1245782356, bb45788922 is correct or incorrect?
Click to expand...
Hi Dante please check the screen shot i have mention in column B only mobile numbers only
 
Upvote 0
DanteAmor said:
You can put a couple of examples of what you want to capture in a cell and that it is valid for you.
That is to say:
a1234, 2345 is correct or incorrect?
1245782356, 1245788922 is correct or incorrect?
1245782356, bb45788922 is correct or incorrect?
Click to expand...
mobile numbers with any special character like

8734263498 | 7398235498 | 3984348734

like this i am typing any mobile number in any cell of column B of 1 or 3 mobile numbers with any special character & then it will showing msgbox please check the number & deleting these mobile numbers in that cell
 
Upvote 0
Your code has some problems.
If you capture data in a column other than column B, it also looks for the number in column B. You should only focus on the data captured in column B.

Prasad K said:
with any special character
Click to expand...
Not just any special character, let's just set the character: |

Try the following code and if some test is not what you need, then you come back here and tell me what data you are capturing and what result you expect.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, c As Range, f As Range, r As Range
  Dim mobile As Variant, mbl As String
  Dim cell As String
  
  Set r = Range("B:B")
  Set rng = Intersect(Target, r)
  
  If Not rng Is Nothing Then
    For Each c In rng
      If c.Value <> "" Then
        For Each mobile In Split(c.Value, "|")
          mbl = WorksheetFunction.Trim(mobile)
          If Len(mbl) <> 10 Then
            MsgBox "Please check the number you have Enter The Mobile should be contain 10 Digits only"
            Application.EnableEvents = False
            c.Value = ""
            Application.EnableEvents = True
            Exit For
          Else
            Set f = r.Find(mbl, , xlValues, xlPart, , , False)
            If Not f Is Nothing Then
              cell = f.Address
              Do
                If f.Address <> c.Address Then
                  If MsgBox("You have Entered the Mobile Number '" & mbl & _
                     "' is Already Exist in cell " & f.Address(0, 0) & 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") = vbNo Then
                    Application.EnableEvents = False
                    c.Value = ""
                    Application.EnableEvents = True
                    Exit For
                  Else
                    Exit Do
                  End If
                End If
                Set f = r.FindNext(f)
              Loop While Not f Is Nothing And f.Address <> cell
            End If
          End If
        Next
      End If
    Next
  End If
End Sub
 
Upvote 0
DanteAmor said:
Your code has some problems.
If you capture data in a column other than column B, it also looks for the number in column B. You should only focus on the data captured in column B.


Not just any special character, let's just set the character: |

Try the following code and if some test is not what you need, then you come back here and tell me what data you are capturing and what result you expect.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, c As Range, f As Range, r As Range
  Dim mobile As Variant, mbl As String
  Dim cell As String
 
  Set r = Range("B:B")
  Set rng = Intersect(Target, r)
 
  If Not rng Is Nothing Then
    For Each c In rng
      If c.Value <> "" Then
        For Each mobile In Split(c.Value, "|")
          mbl = WorksheetFunction.Trim(mobile)
          If Len(mbl) <> 10 Then
            MsgBox "Please check the number you have Enter The Mobile should be contain 10 Digits only"
            Application.EnableEvents = False
            c.Value = ""
            Application.EnableEvents = True
            Exit For
          Else
            Set f = r.Find(mbl, , xlValues, xlPart, , , False)
            If Not f Is Nothing Then
              cell = f.Address
              Do
                If f.Address <> c.Address Then
                  If MsgBox("You have Entered the Mobile Number '" & mbl & _
                     "' is Already Exist in cell " & f.Address(0, 0) & 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") = vbNo Then
                    Application.EnableEvents = False
                    c.Value = ""
                    Application.EnableEvents = True
                    Exit For
                  Else
                    Exit Do
                  End If
                End If
                Set f = r.FindNext(f)
              Loop While Not f Is Nothing And f.Address <> cell
            End If
          End If
        Next
      End If
    Next
  End If
End Sub
Click to expand...
Hi Dante Your Code Super Excellent

in this code also i want some small change's

when i type duplicate mobile number in cell of column B

it's just deleting mobile number only if i press (NO) & my query is if duplicate mobile number found it should delete entire row of that duplicate mobile number when i press (NO)
 
Upvote 0
Prasad K said:
...is if duplicate mobile number found it should delete entire row ...
Click to expand...

Try this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, c As Range, f As Range, r As Range
  Dim mobile As Variant, mbl As String
  Dim cell As String
  
  Set r = Range("B:B")
  Set rng = Intersect(Target, r)
  
  If Not rng Is Nothing Then
    For Each c In rng
      If c.Value <> "" Then
        For Each mobile In Split(c.Value, "|")
          mbl = WorksheetFunction.Trim(mobile)
          If Len(mbl) <> 10 Then
            MsgBox "Please check the number you have Enter The Mobile should be contain 10 Digits only"
            Application.EnableEvents = False
            c.Value = ""
            Application.EnableEvents = True
            Exit For
          Else
            Set f = r.Find(mbl, , xlValues, xlPart, , , False)
            If Not f Is Nothing Then
              cell = f.Address
              Do
                If f.Address <> c.Address Then
                  If MsgBox("You have Entered the Mobile Number '" & mbl & _
                     "' is Already Exist in cell " & f.Address(0, 0) & 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") = vbNo Then
                    Application.EnableEvents = False
                    'c.Value = ""
                    c.EntireRow.Delete
                    Application.EnableEvents = True
                    Exit Sub
                  Else
                    Exit Do
                  End If
                End If
                Set f = r.FindNext(f)
              Loop While Not f Is Nothing And f.Address <> cell
            End If
          End If
        Next
      End If
    Next
  End If
End Sub
 
Upvote 0
DanteAmor said:
Try this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, c As Range, f As Range, r As Range
  Dim mobile As Variant, mbl As String
  Dim cell As String
 
  Set r = Range("B:B")
  Set rng = Intersect(Target, r)
 
  If Not rng Is Nothing Then
    For Each c In rng
      If c.Value <> "" Then
        For Each mobile In Split(c.Value, "|")
          mbl = WorksheetFunction.Trim(mobile)
          If Len(mbl) <> 10 Then
            MsgBox "Please check the number you have Enter The Mobile should be contain 10 Digits only"
            Application.EnableEvents = False
            c.Value = ""
            Application.EnableEvents = True
            Exit For
          Else
            Set f = r.Find(mbl, , xlValues, xlPart, , , False)
            If Not f Is Nothing Then
              cell = f.Address
              Do
                If f.Address <> c.Address Then
                  If MsgBox("You have Entered the Mobile Number '" & mbl & _
                     "' is Already Exist in cell " & f.Address(0, 0) & 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") = vbNo Then
                    Application.EnableEvents = False
                    'c.Value = ""
                    c.EntireRow.Delete
                    Application.EnableEvents = True
                    Exit Sub
                  Else
                    Exit Do
                  End If
                End If
                Set f = r.FindNext(f)
              Loop While Not f Is Nothing And f.Address <> cell
            End If
          End If
        Next
      End If
    Next
  End If
End Sub
Click to expand...
Thank you so much Dante
You are Excel Super Star
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0
DanteAmor said:
Try this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, c As Range, f As Range, r As Range
  Dim mobile As Variant, mbl As String
  Dim cell As String
 
  Set r = Range("B:B")
  Set rng = Intersect(Target, r)
 
  If Not rng Is Nothing Then
    For Each c In rng
      If c.Value <> "" Then
        For Each mobile In Split(c.Value, "|")
          mbl = WorksheetFunction.Trim(mobile)
          If Len(mbl) <> 10 Then
            MsgBox "Please check the number you have Enter The Mobile should be contain 10 Digits only"
            Application.EnableEvents = False
            c.Value = ""
            Application.EnableEvents = True
            Exit For
          Else
            Set f = r.Find(mbl, , xlValues, xlPart, , , False)
            If Not f Is Nothing Then
              cell = f.Address
              Do
                If f.Address <> c.Address Then
                  If MsgBox("You have Entered the Mobile Number '" & mbl & _
                     "' is Already Exist in cell " & f.Address(0, 0) & 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") = vbNo Then
                    Application.EnableEvents = False
                    'c.Value = ""
                    c.EntireRow.Delete
                    Application.EnableEvents = True
                    Exit Sub
                  Else
                    Exit Do
                  End If
                End If
                Set f = r.FindNext(f)
              Loop While Not f Is Nothing And f.Address <> cell
            End If
          End If
        Next
      End If
    Next
  End If
End Sub
Click to expand...
Hi Dante

Here i want a small help from you again

in this Msgbox You have Entered the Mobile Number '8045791489' is Already Exist in Cell B4

can you change this into like this

Msgbox You have Entered the Mobile Number '8045791489' is Already Exist in Cell B4 For 'Talwar Hyundai Pvt Ltd'

i mention a screen shot please see how i am asking for Msgbox
 

Attachments

  • D1.JPG
    D1.JPG
    88.1 KB · Views: 14
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
158
Lil Stinker
L
W
  • Solved
Multiple MsgBox based on the same column but different keywords in the column
Replies
3
Views
145
kevin9999
K
H
  • Solved
problem with code- removing duplicate rows
Replies
2
Views
170
heathball
H
W
  • Solved
pop up msgbox dependent on specific text entered into userform combobox
Replies
3
Views
283
Wishful Thinking
W
P
  • Solved
Advice needed on where to put code that stops duplicate entries
Replies
5
Views
323
Pacman52
P

Forum statistics

Threads
1,215,337
Messages
6,124,340
Members
449,155
Latest member
ravioli44

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