Creating a "duplicate found msg" in VBA

J

Jayliam

New Member
Joined
May 12, 2015
Messages
29
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
I am very, very new to programming in VBA. I have come up with the following code for VBA. But, it doesn't work. I can still enter a duplicate. Can someone please share with me what I'm doing wrong?

If Trim(Me.txtheatcode.Value) = "" Then
MsgBox "Please enter a Heat Code"
If Trim(Me.txtheatcode.Value) = (Sheets("PartsData").Range("D2:D999")) = 0 Then
MsgBox "Duplicate Heat Code Found"
Me.txtheatcode.SetFocus
End If

Thank you for your time.
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Sort by date Sort by votes
Jayliam said:
I am very, very new to programming in VBA. I have come up with the following code for VBA. But, it doesn't work. I can still enter a duplicate. Can someone please share with me what I'm doing wrong?

If Trim(Me.txtheatcode.Value) = "" Then
MsgBox "Please enter a Heat Code"
If Trim(Me.txtheatcode.Value) = (Sheets("PartsData").Range("D2:D999")) = 0 Then
MsgBox "Duplicate Heat Code Found"
Me.txtheatcode.SetFocus
End If
Click to expand...
Try substituting the following for the highlighted line of code and see if that works for you...
Code: 
If Application.CountIf(Sheets("PartsData").Range("D2:D999"), Trim(Me.txtheatcode.Value)) Then
 
Upvote 0
Jayliam said:
I am very, very new to programming in VBA. I have come up with the following code for VBA. But, it doesn't work. I can still enter a duplicate. Can someone please share with me what I'm doing wrong?

If Trim(Me.txtheatcode.Value) = "" Then
MsgBox "Please enter a Heat Code"
If Trim(Me.txtheatcode.Value) = (Sheets("PartsData").Range("D2:D999")) = 0 Then
MsgBox "Duplicate Heat Code Found"
Me.txtheatcode.SetFocus
End If

Thank you for your time.
Click to expand...
Hard to tell from your snippet what your data layout looks like and what your variables refer to. If you can provide some more details about these things and exactly what you want to accomplish you will improve your chances of getting some help.
 
Upvote 0
I tried this line of code and am getting, "Block If without End If" error. Any suggestions?
 
Upvote 0
Jayliam said:
I tried this line of code and am getting, "Block If without End If" error. Any suggestions?
Click to expand...
That probably has something to do with your full code, but since you did not show us your full code, it is hard to give you a solution. I can tell you that the snippet of code you posted has two If statements but only one End If, so if you full code does not close of that second If with its own End If, that would cause the error message you received.
 
Upvote 0
Here is the whole code.

Option Explicit

Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("PartsData")

iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

If Trim(Me.txtwonumber.Value) = "" Then
Me.txtwonumber.SetFocus
MsgBox "Please enter a Work Order Number"
Exit Sub
End If

If Trim(Me.txtpnumber.Value) = "" Then
Me.txtpnumber.SetFocus
MsgBox "Please enter a Part Number"
Exit Sub
End If

If Trim(Me.txtsnumber.Value) = "" Then
Me.txtsnumber.SetFocus
MsgBox "Please enter a Serial Number"
Exit Sub
End If

If Trim(Me.txtheatcode.Value) = "" Then
MsgBox "Please enter a Heat Code"
If Application.CountIf(Sheets("PartsData").Range("D2:D999"), Trim(Me.txtheatcode.Value)) Then
MsgBox "Duplicate Heat Code Found"
Me.txtheatcode.SetFocus
Exit Sub
End If

With ws
.Cells(iRow, 1).Value = Me.txtwonumber.Value
.Cells(iRow, 2).Value = Me.txtpnumber.Value
.Cells(iRow, 3).Value = Me.txtsnumber.Value
.Cells(iRow, 4).Value = Me.txtheatcode.Value
.Cells(iRow, 5).Value = Me.txtdescription.Value

End With

If CheckBox1.Value = True Then Me.txtAFdate.Value = Format(Date, "Medium Date")
If CheckBox1.Value = False Then Me.txtAFdate.Value = ""

If CheckBox2.Value = True Then Me.txtSPdate.Value = Format(Date, "Medium Date")
If CheckBox2.Value = False Then Me.txtSPdate.Value = ""

If CheckBox3.Value = True Then Me.txtMPdate.Value = Format(Date, "Medium Date")
If CheckBox3.Value = False Then Me.txtMPdate.Value = ""

If CheckBox4.Value = True Then Me.txtPdate.Value = Format(Date, "Medium Date")
If CheckBox4.Value = False Then Me.txtPdate.Value = ""

With ws
.Cells(iRow, 6).Value = Me.txtAFdate.Value
.Cells(iRow, 7).Value = Me.txtSPdate.Value
.Cells(iRow, 8).Value = Me.txtMPdate.Value
.Cells(iRow, 9).Value = Me.txtPdate.Value
End With

Me.txtwonumber.Value = ""
Me.txtpnumber.Value = ""
Me.txtsnumber.Value = ""
Me.txtheatcode.Value = ""
Me.txtwonumber.SetFocus

End Sub
 
Upvote 0
Jayliam said:
Here is the whole code.

Option Explicit

Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("PartsData")

iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

If Trim(Me.txtwonumber.Value) = "" Then
Me.txtwonumber.SetFocus
MsgBox "Please enter a Work Order Number"
Exit Sub
End If

If Trim(Me.txtpnumber.Value) = "" Then
Me.txtpnumber.SetFocus
MsgBox "Please enter a Part Number"
Exit Sub
End If

If Trim(Me.txtsnumber.Value) = "" Then
Me.txtsnumber.SetFocus
MsgBox "Please enter a Serial Number"
Exit Sub
End If

If Trim(Me.txtheatcode.Value) = "" Then
MsgBox "Please enter a Heat Code"
If Application.CountIf(Sheets("PartsData").Range("D2:D999"), Trim(Me.txtheatcode.Value)) Then
MsgBox "Duplicate Heat Code Found"
Me.txtheatcode.SetFocus
Exit Sub
End If
End If

With ws
.Cells(iRow, 1).Value = Me.txtwonumber.Value
.Cells(iRow, 2).Value = Me.txtpnumber.Value
.Cells(iRow, 3).Value = Me.txtsnumber.Value
.Cells(iRow, 4).Value = Me.txtheatcode.Value
.Cells(iRow, 5).Value = Me.txtdescription.Value

End With

If CheckBox1.Value = True Then Me.txtAFdate.Value = Format(Date, "Medium Date")
If CheckBox1.Value = False Then Me.txtAFdate.Value = ""

If CheckBox2.Value = True Then Me.txtSPdate.Value = Format(Date, "Medium Date")
If CheckBox2.Value = False Then Me.txtSPdate.Value = ""

If CheckBox3.Value = True Then Me.txtMPdate.Value = Format(Date, "Medium Date")
If CheckBox3.Value = False Then Me.txtMPdate.Value = ""

If CheckBox4.Value = True Then Me.txtPdate.Value = Format(Date, "Medium Date")
If CheckBox4.Value = False Then Me.txtPdate.Value = ""

With ws
.Cells(iRow, 6).Value = Me.txtAFdate.Value
.Cells(iRow, 7).Value = Me.txtSPdate.Value
.Cells(iRow, 8).Value = Me.txtMPdate.Value
.Cells(iRow, 9).Value = Me.txtPdate.Value
End With

Me.txtwonumber.Value = ""
Me.txtpnumber.Value = ""
Me.txtsnumber.Value = ""
Me.txtheatcode.Value = ""
Me.txtwonumber.SetFocus

End Sub
Click to expand...
Like I said would probably be the case, the code you posted above was missing an End If statement... I inserted into the above posted code and colored it red so you could easily find it.
 
Upvote 0
Thank you. This fixed the error msg but I'm still able to enter duplicate information. Is there anyway for the entered text to be compared to a column for duplication?
 
Upvote 0
Jayliam said:
Thank you. This fixed the error msg but I'm still able to enter duplicate information. Is there anyway for the entered text to be compared to a column for duplication?
Click to expand...
Well, it kind of depends on what you are ultimately trying to do. The snippet you gave us originally was for txtheatcode, so theoretically, that duplicate will be flagged, but not any of the other textboxes because, until your last posting, we did not know they existed. Are duplicates for them to be forbidden also? I also see (again, because it is being shown to us for the first time in your last posting) that you have your code in a Click event... that, of course, can only do its work when clicked and, as written, won't stop a duplicate from being entered, it will only flag that a duplicate exists.
 
Upvote 0
The only text box I need to check for duplicates in is the txtheatcode. All the other text boxes can have duplicates. Once the user has clicked to add this information I need this program to verify there is no duplicate in column D and if there is to reject their entry while notifying them.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Advice needed on where to put code that stops duplicate entries
Replies
5
Views
298
Pacman52
P
P
  • Question
Checking if any text has been entered
Replies
2
Views
196
Pacman52
P
U
  • Question
Remove Duplicates from a cell/ Create a cell with unique values from a cell with duplicate Values.
Replies
1
Views
385
eiloken
E
M
  • Question
Add in VBA Code to check zip code against pre-determined list
Replies
0
Views
145
mikefisher
M
P
  • Solved
Checking Textbox For Specific Text Entry
Replies
4
Views
191
Pacman52
P

Forum statistics

Threads
1,214,525
Messages
6,120,051
Members
448,940
Latest member
mdusw

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