How to delete duplicate values? - excel

I dynamically update the cells in columns A and B, and join both values on each row (using &) and place the values in column C.
My purpose is fulfilled by detecting duplicate names when firstName (Column A values) and LastName (column B values) are entered twice. An empty value (observed when the msgbox is displayed) pops up when I delete the duplicate name followed by the first occurrence.
This is an issue at times, especially because sometimes the msgbox does not go away. ie the code crashes.
How can I prevent the empty value, or msgBox from being displayed? I suspect something is wrong with my if statement.
VBA code I placed in the worksheet
Private Sub Worksheet_Change(ByVal Target As Range)
If WorksheetFunction.CountIf(Range("c1:c12"), Target.Offset(0, 1).Value) > 1 And _
Target.Offset(0, 1).Value <> " " Then
MsgBox Target.Offset(0, 1).Value & " is a Duplicate Entry" & vbNewLine & _
" ENTER A NEW NAME", vbInformation, "Duplicate Detected"
Target.Offset(0, 0).Value = " "
Target.Offset(0, 0).Select
ElseIf WorksheetFunction.CountIf(Range("c1:c12"), Target.Offset(0, 2).Value) > 1 And _
Target.Offset(0, 1).Value <> " " Then
MsgBox Target.Offset(0, 2).Value & " is a Duplicate Entry" & vbNewLine & _
" ENTER A NEW NAME", vbInformation, "Duplicate Detected"
Target.Offset(0, 0).Value = " "
Target.Offset(0, 0).Select
Else: Exit Sub
End If
End Sub

If i wanted to create a sheet with
-2 -1 0
ColA ColB ColC
First1 Last1 First1Last1
First2 Last2 First2Last2
First3 Last3 First3Last3
First4 Last4
I would personally start with conditional formatting for ColC to flag what is a duplicate, in case there is an issue, which circumvents a messagebox.
If i did need a messagebox, i would set up similar to what you have:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns(3)) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Application.CountIfs(Range("C1:C12"),Target.Value) > 1 Then 'checks for first/last name
MsgBox("The name " & Target.Offset(0,-2).Value & " " & Target.Offset(0,-1).Value & " already exists." & vbNewLine & "Please enter a new name.")
End If
End Sub
Edit1:
Given the data entry for colA and colB, would this be more appropriate? I utilized the row of the target, so the negative offset shouldn't be of concern, since you know that colA is first name and colB is last name.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim r as long
r = target.row
If isempty(cells(r,1)) or isempty(cells(r,2)) then exitsub
If Application.CountIfs(Range("B1:B12"),cells(r,2).Value,Range("A1:A12"),cells(r,1).Value) > 1 Then 'checks for first/last name
MsgBox("The name " & cells(r,1).Value & " " & cells(r,2).Value & " already exists." & vbNewLine & "Please enter a new name.")
End If
End Sub
Edit2:
In verifying the use of no values and some values, this macro has been working for my testing (i added the clear contents and .select so you are back on the line you should be adding data); i also added a range specification related to the intersect in case you are adding values like first/last to a random place outside of a1:b12:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range(Cells(1, 1), Cells(12, 2))) Is Nothing Then Exit Sub
Dim r As Long
r = Target.Row
If IsEmpty(Cells(r, 1)) Or IsEmpty(Cells(r, 2)) Then Exit Sub
If Application.CountIfs(Range("B1:B12"), Cells(r, 2).Value, Range("A1:A12"), Cells(r, 1).Value) > 1 Then 'checks for first/last name
MsgBox ("The name " & Cells(r, 1).Value & " " & Cells(r, 2).Value & " already exists." & vbNewLine & "Please enter a new name.")
Cells(r, 1).ClearContents
Cells(r, 2).ClearContents
Cells(r, 1).Select
End If
End Sub

Related

Allow alpha numeric values instead of isnumeric

I have the below code for entering a function and copying the orientation and borders of the above line.
But in this it only accept numeric values, how can i modify the code so that i can enter alpa numeric values in that cell.
Below is the code
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If IsNumeric(Target.Value) Then ' Check if cell contains a numeric value
If Target.Value <> "" Then
Range("A" & Target.Row).Formula = "=IF(B" & Target.Row & "<>"""",ROW()-ROW($A$15)+1,"""")"
' Copy border, border color and orientation from row above
With Range("A" & Target.Row & ":H" & Target.Row)
.Borders.LineStyle = .Offset(-1, 0).Borders.LineStyle
.Borders.Color = .Offset(-1, 0).Borders.Color
.Orientation = .Offset(-1, 0).Orientation
End With
Else
' Check if entire row in column B is empty
If WorksheetFunction.CountA(Range("B" & Target.Row & ":H" & Target.Row)) = 0 Then
' Delete entire row
Rows(Target.Row).Delete
Else
' Clear contents of column A to H for the row where value was deleted in column B
Range("A" & Target.Row & ":H" & Target.Row).ClearContents
End If
End If
End If
End If
End Sub
Here's a small Function you could add to your code, to give it IsAlphaNumeric functionality.
Function IsAlphaNumeric(t) as Boolean
Dim i as Long
IsAlphaNumeric = True
For i = 1 To Len(t)
If Not (Mid(t, i, 1) Like "[A-z0-9]") Then
IsAlphaNumeric = False
Exit For
End If
Next
End Function
You can use it like this:
If IsAlphaNumeric(Target.Value) Then ' Check if cell contains alpha-numeric value

In MS-Excel how to append on existing cell value?

I want to create cell wise log. The first image shows concat value in the third column. Now if I change the value in the first and second columns, I want the new concat value to be added [append] in the third column, not removing old data.
How to do that?
Solved the issue with VBA in Excel. added comment in this below code.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo myerror
Application.EnableEvents = False
Dim c As Range
'K1:AC1 is the column range where the date field exits
For Each c In Range("K1:AC1")
'if the cell value has the current date
If c.Value = Date Then
'if column E is blank
If Cells(Target.Row, "E").Value = "" Then
Cells(Target.Row, c.Column).Value = "created today"
'if column E is not blank
Else
'Cells(Target.Row, c.Column).Value = 'created today'
'Cells(Target.Row, "H").Value = 'Gobinda Nandi (Dev)'
'Cells(Target.Row, "E").Value = '(Status: In Progress)'
'Cells(Target.Row, "J").Value = 'WIP'
Cells(Target.Row, c.Column).Value = Cells(Target.Row, c.Column).Value & vbNewLine & "[" & Format(Now, "HH:MM Am/Pm") & "] " & Cells(Target.Row, "H").Value & " (Status: " & Cells(Target.Row, "E").Value & "), Comment: " & Cells(Target.Row, "J").Value
'OUTPUT:
'created today
'[11:37 AM] Gobinda Nandi (Dev) (Status: In Progress), Comment: WIP
End If
End If
Next c
'making empty cell
Cells(Target.Row, "J").Value = ""
myerror:
Application.EnableEvents = True
'error handling code
End Sub
OUTPUT:

Can't figure out problem with Excel VBA code

I am fairly new to writing code in excel VBA. Most of this code is some I have tried to replicated based on what other people have wrote. The problem I am having is I have a quantity counter and when a barcode is scanned into the cell (A4) it will add the barcode to a new cell (Starts at C8 and goes down) and if this barcode is already scanned once and is scanned again it will add one to the quantity. Now I am trying to add a date and time next to it as a barcode is scanned. This works but has an issue I can't figure out. The barcode must be scanned twice for the date to appear in the proper cell. This is an issue because it raises the quantity up one more than it should. Please help.
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Address
Case "$A$4"
If Target.Value <> "" Then
On Error Resume Next
Set xitem = Range("C8", Range("C" & Rows.Count) _
.End(xlUp)).Find(Range("A4").Value)
With xitem.Offset(0, -1)
.Value = .Value + 1
.Offset(0, 1).Select
End With
With xitem.Offset(0, 1)
.Value = Date & " " & Time
.NumberFormat = "m/d/yyyy h:mm AM/PM"
End With
On Error GoTo 0
If xitem Is Nothing Then
With Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
.Value = Target.Value
.Offset(0, -1) = 1
End With
End If
Range("A4") = ""
Range("A4").Select
End If
Adds quantity
Case "$C$4"
If Target.Value <> "" Then
On Error Resume Next
Set xitem = Range("C8", Range("C" & Rows.Count).End(xlUp)) _
.Find(Range("C4").Value)
With xitem.Offset(0, -1)
.Value = .Value - 1
End With
If xitem Is Nothing Then MsgBox Target & " cannot be found " _
& "and cannot be removed."
Range("C4") = ""
Range("C4").Select
On Error GoTo 0
End If
Removes quantity (I am going to add an out time to this just trying to get the initial scan time in first)
Case "$E$4" 'find
If Target.Value <> "" Then
On Error Resume Next
Set xitem = Range("C8", Range("C" & Rows.Count).End(xlUp)) _
.Find(Range("E4").Value)
If xitem Is Nothing Then
MsgBox Target & " was not found."
Range("E4").Select
End If
Range("E4") = ""
xitem.Select
On Error GoTo 0
End If
End Select
End Sub
This is what I am using to take me directly to a barcode that has already been scanned.
Sorry if this post is badly formatted never posted before. Any and all help with this issue is appreciated. A photo of the spread sheet is also attached.
You are repeating some things within your code which you only need to do once, like the Find() for example.
Here's one alternative approach:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Adding As Boolean, Finding As Boolean, Subtracting As Boolean
Dim f As Range, v
Select Case Target.Address(True, True)
Case "$A$4": Adding = True
Case "$C$4": Subtracting = True
Case "$E$4": Finding = True
Case Else: Exit Sub
End Select
v = Trim(Target.Value)
If Len(v) = 0 Then Exit Sub
Set f = Me.Range("C8").Resize(1000, 1).Find(v, lookat:=xlWhole)
If Adding Then
If f Is Nothing Then
'not found: add as new row
Set f = Me.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
f.Value = v
End If
f.Offset(0, 1).Value = f.Offset(0, 1).Value + 1
doDate f.Offset(0, -1)
Target.Value = ""
ElseIf Subtracting Then
If f Is Nothing Then
MsgBox v & " not found for subtraction!"
Else
f.Offset(0, 1).Value = f.Offset(0, 1).Value - 1
doDate f.Offset(0, -1)
Target.Value = ""
End If
Else 'finding
If Not f Is Nothing Then
f.EntireRow.Select
Target.Value = ""
Else
MsgBox v & " not found."
End If
End If
If Adding Or Subtracting Then Target.Select
End Sub
Sub doDate(c As Range)
With c
.NumberFormat = "m/d/yyyy h:mm AM/PM"
.Value = Now
End With
End Sub

Make cell mandatory in excel using vba

I have tried this code for creating mandatory fields but the problem is it is showing the error message before going to the cell.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.count, "A").End(xlUp).Row
Dim I, J As Integer
For I = 1 To lastRow
If Cells(I, "C").Value = "" Then
MsgBox "Please Enter Business Type Value", vbOKOnly
Exit Sub
End If
'If Cells(I, "D").Value = "" Then
'MsgBox "Please Enter Customer Account Code", vbOKOnly
'Exit Sub
'End If
'If Cells(I, "E").Value = "" Then
'MsgBox "Please Enter Transport Mode Value", vbOKOnly
'Exit Sub
'End If
'If Cells(I, "F").Value = "" Then
'MsgBox "Please Enter Incoterm Value", vbOKOnly
'Exit Sub
'End If
'If Cells(I, "K").Value = "" Then
'MsgBox "Please Enter From date Value", vbOKOnly
'Exit Sub
'End If
'If Cells(I, "L").Value = "" Then
'MsgBox "Please Enter To date Value", vbOKOnly
'Exit Sub
'End If
'If Cells(I, "K").Value > Cells(I, "L").Value Then
'MsgBox "To date value should greater than From value", vbOKOnly
'Exit Sub
'End If
'If Cells(I, "N").Value = "" Then
'MsgBox "Please Enter Origin Country Code Value", vbOKOnly
'Exit Sub
'End If
'If Cells(I, "O").Value = "" Then
'MsgBox "Please Enter Point of Origin Location Code Value", vbOKOnly
'Exit Sub
'End If
'If Cells(I, "R").Value = "" Then
'MsgBox "Please Enter Port of Loading Code Value", vbOKOnly
'Exit Sub
'End If
'If Cells(I, "S").Value = "" Then
'MsgBox "Please Enter Origin Clearance Location Value", vbOKOnly
'Exit Sub
'End If
'If Cells(I, "T").Value = "" Then
'MsgBox "Please Enter Destination Clearance Location Value", vbOKOnly
'Exit Sub
'End If
'If Cells(I, "U").Value = "" Then
'MsgBox "Please Enter Port of Discharge Code Value", vbOKOnly
'Exit Sub
'End If
If Cells(I, "Y").Value = "" Then
MsgBox "Please Enter Consignee Final Destination Location Code Value", vbOKOnly
Exit Sub
End If
If Cells(I, "Z").Value = "" Then
MsgBox "Please Enter Destination Country Code Value", vbOKOnly
Exit Sub
End If
If Cells(I, "AF").Value = "" Then
MsgBox "Please Enter Active status Value", vbOKOnly
Exit Sub
End If
If Cells(I, "AH").Value = "" Then
MsgBox "Please Enter Carrier Allocation Number Value", vbOKOnly
Exit Sub
End If
If Cells(I, "AI").Value = "" Then
MsgBox "Please Enter Carrier Allocation Valid From Date Value", vbOKOnly
Exit Sub
End If
If Cells(I, "AJ").Value = "" Then
MsgBox "Please Enter Carrier Nomination Sequence Number Value", vbOKOnly
Exit Sub
End If
Next I
End With
End Sub
This code
tracks A1:A10 to see if any cells are changed
then looks to see if the corresponding cell in row Y is empty
if empty a message is returned and the cell in A1:A10 that was changed is then blanked out
code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Target, [a1:a10])
'exit if no cells in A1:A10 are changed
If rng1 Is Nothing Then Exit Sub
'turn off events to avoid code retriggering itself
Application.EnableEvents = False
For Each rng2 In rng1
If Cells(rng2.Row, "Y") = vbNullString Then
MsgBox "Please Enter Consignee Final Destination Location Code Value, your entry will be deleted", vbOKOnly
rng2.Value = vbNullString
End If
Next
Application.EnableEvents = True
End Sub
Another approach would be:
In your Worksheet_SelectionChange make all cells which do not pass your checks red. All who pass your checks green. You can do this with the following code. Do not produce any error messages in this procedure.
Range("A1").Interior.Color = RGB(255, 0, 0) 'red
Range("A1").Interior.Color = RGB(0, 255, 0) 'green
Do only allow saving the workbook if all your checks are passed. Therefore you can use the proceudre I have provided you in the other answer.
I think the event you are using may cause your problem.
You could implement mandatory fields with the Workbook_BeforeSave event. This will get fired, as soon as the user tries to save the excel file. Now you check all your fields which you define as mandatory and display the respective "error message".
When you set Cancel = True you can abort the saving process wich then really forces the user to add something in the required fields.
In the Workbook_BeforeSave event you can paste in all your checks you have already implemented.
More details on the Workbook_BeforeSave can be found here: https://msdn.microsoft.com/de-de/library/office/ff840057.aspx
Here you can find more info on how to implement the Workbook_BeforeSave event:http://www.positivevision.biz/blog/bid/153139/Excel-Tips-and-Tricks-Mandatory-Cell-Input

Excel VBA - Value & MsgBox

I posted a question about this piece of code that is already changed by "Alex Bell", He helped me with the code making a MsgBox appear every time the value "496" appears in that specific range. But due to my poor knowledge in this language, there's a lot of things I cannot do.
the next step I was trying to achieve was doing the same thing that is already done, the MsgBox alert if the value is "496", but now with "800" too.
So what is the problem? The Problem is that I cannot figure a way to put the two conditions to work together, for example it tells me where is the "496" and then the "800" and fills both of the cells that contain that specific values.
It's probably a easy question to solve, but again I'm a newbie to vba and when I studied vb in school we didn't learn that much. So be expecting more questions from me on topics related to vba and I'm trying to learn it at the moment.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
If Not Intersect(Target, Range("G3:G500")) Is Nothing Then
For Each cell In Target
'need clarification
'Me.Cells(cell.Row, "496").Interior.ColorIndex = xlColorIndexNone
'If cell.Value <> "" And cell.Value <> prevValue Then
'Me.Cells(cell.Row, "496").Interior.ColorIndex = 3
'End If
If cell.Value = "496" Then
cell.Interior.ColorIndex = 43
MsgBox ("The row where the status is 496 is located in: " & cell.Row)
Else
cell.Interior.ColorIndex = xlColorIndexNone
End If
Next cell
End If
'If Not Intersect(Target, Range("G3:G500")) Is Nothing Then
' For Each cell In Target
'
' If cell.Value = "800" Then
' cell.Interior.ColorIndex = 4
' MsgBox ("The row where the status is 800 is located in: " & cell.Row)
' Else
' cell.Interior.ColorIndex = xlColorIndexNone
' End If
' Next cell
'End If
End Sub
If cell.Value = "496" Or cell.Value = "800" Then
cell.Interior.ColorIndex = 43
MsgBox ("The row where the status is 496 or 800 is located in: " & cell.Row)
Else
cell.Interior.ColorIndex = xlColorIndexNone
End If
Or like this:
If cell.Value = "496" Then
cell.Interior.ColorIndex = 43
MsgBox ("The row where the status is 496 is located in: " & cell.Row)
ElseIf cell.Value = "800" Then
cell.Interior.ColorIndex = 45
MsgBox ("The row where the status is 800 is located in: " & cell.Row)
Else
cell.Interior.ColorIndex = xlColorIndexNone
End If
If you would like to have more checks, you can consider to store the row numbers to print into a variable and at the very end you can call the MsgBox:
Dim rowNumbers As String
rowNumbers = ""
If Not Intersect(Target, Range("G3:G500")) Is Nothing Then
For Each cell In Target
If cell.Value = "496" Then
cell.Interior.ColorIndex = 43
rowNumbers = rowNumbers & cell.Row & " "
ElseIf cell.Value = "800" Then
cell.Interior.ColorIndex = 45
rowNumbers = rowNumbers & cell.Row & " "
Else
cell.Interior.ColorIndex = xlColorIndexNone
End If
Next cell
MsgBox ("The rows where the status is 496 or 800 is located in: " & rowNumbers)
End If

Resources