View Full Version : VBA code for message box popup if data already exist.
Master_Viper
07-26-2016, 02:37 PM
Hello Expert,
What I want to do is when I clicked the Update Data button in Data_Entry and the data already exist in ER100_Activation_Configuration sheet a message box should be displayed.
I want to check if the unique data under column E Row 19 of Data_Entry sheet was already exist.
See attach file.
JKwan
07-27-2016, 07:55 AM
See if this is what you want. Replace your Sheet4 code with below
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, a, b, c As String
Dim Found As Range
Set Found = Find_All(Range("E9"), Worksheets("ER100_Activation_Configuration").Range("E11:E100"), , xlWhole)
If Not Found Is Nothing Then
MsgBox "Found - " & Range("E9")
End If
Ln = 7
Set sh1 = Sheets("Data_Entry")
x = Mid(sh1.Range("E431"), 5, Ln)
With Range("E431")
.Value = x
.NumberFormat = WorksheetFunction.Rept("0", Ln)
End With
Set sh1 = Sheets("Data_Entry")
If sh1.Range("S448") = "N" Or sh1.Range("S448") = "ONT" Or sh1.Range("S448") = "PON" Then
b = "3Spring"
Else: sh1.Range("S448") = "Nest3"
b = "4Spring"
End If
If sh1.Range("E448") = "2858097400100" Then
c = "PS100"
Else: sh1.Range("E448") = "2858041501100"
c = "PS60"
End If
a = Array(sh1.Range("E19").Value, sh1.Range("E9").Value, sh1.Range("E7").Value, Mid(sh1.Range("E7"), 10, 4), sh1.Range("M446").Value, sh1.Range("O9").Value, _
sh1.Range("E434").Value, Mid(sh1.Range("E434"), 5, 7), sh1.Range("S444").Value, sh1.Range("E440").Value, Mid(sh1.Range("E440"), 5, 7), _
sh1.Range("E448").Value, c, sh1.Range("S448").Value, b)
With Sheets("ER100_Activation_Configuration").Cells(Rows.Count, 4).End(xlUp).Offset(1)
.Resize(, 21).Value = a
.Resize(, 21).NumberFormat = "0"
.Offset(, -2).Value = .Row() - 2
.Offset(, -1).Value = Format(Now(), "mm-dd-yy")
End With
End Sub
Function Find_All(Find_Item As Variant, Search_Range As Range, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlPart, _
Optional MatchCase As Boolean = False) As Range
Dim c As Range, firstAddress As String
Set Find_All = Nothing
With Search_Range
Set c = .Find( _
what:=Find_Item, _
LookIn:=LookIn, _
LookAt:=LookAt, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=MatchCase, _
searchformat:=False) 'Delete this term for XL2000 and earlier
If Not c Is Nothing Then
Set Find_All = c
firstAddress = c.Address
Do
Set Find_All = Union(Find_All, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Function
Master_Viper
07-27-2016, 09:11 AM
Hello JKwan,
I tried your code above it's working, a message box will display once the data already exist in another sheet. However, when I clicked the OK button in the message box it still copied the same data.
I want the message box looks like this with, "Yes", "No" and "Cancel" button, that when I choose the "Yes" button the action should replaced the existing data while when I choose "No" it will duplicate the existing data and "Cancel" will quit or end the function.
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, a, b, c As String
Dim Found As Range
Set Found = Find_All(Range("E19"), Worksheets("ER100_Activation_Configuration").Range("D11:D100"), , xlWhole)
If Not Found Is Nothing Then
Found = MsgBox("File already exist. Do you want to replace?", vbYesNoCancel, "Found SEMI PN")
'MsgBox "Found - " & Range("E19")
End If
Ln = 7
Set sh1 = Sheets("Data_Entry")
x = Mid(sh1.Range("E431"), 5, Ln)
With Range("E431")
.Value = x
.NumberFormat = WorksheetFunction.Rept("0", Ln)
End With
Set sh1 = Sheets("Data_Entry")
If sh1.Range("S448") = "N" Or sh1.Range("S448") = "ONT" Or sh1.Range("S448") = "PON" Then
b = "3Spring"
Else: sh1.Range("S448") = "Nest3"
b = "4Spring"
End If
If sh1.Range("E448") = "2858097400100" Then
c = "PS100"
Else: sh1.Range("E448") = "2858041501100"
c = "PS60"
End If
a = Array(sh1.Range("E19").Value, sh1.Range("E9").Value, sh1.Range("E7").Value, Mid(sh1.Range("E7"), 10, 4), sh1.Range("M446").Value, sh1.Range("O9").Value, _
sh1.Range("E434").Value, Mid(sh1.Range("E434"), 5, 7), sh1.Range("S444").Value, sh1.Range("E440").Value, Mid(sh1.Range("E440"), 5, 7), _
sh1.Range("E448").Value, c, sh1.Range("S448").Value, b)
With Sheets("ER100_Activation_Configuration").Cells(Rows.Count, 4).End(xlUp).Offset(1)
.Resize(, 21).Value = a
.Resize(, 21).NumberFormat = "0"
.Offset(, -2).Value = .Row() - 2
.Offset(, -1).Value = Format(Now(), "mm-dd-yy")
End With
End Sub
Function Find_All(Find_Item As Variant, Search_Range As Range, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlPart, _
Optional MatchCase As Boolean = False) As Range
Dim c As Range, firstAddress As String
Set Find_All = Nothing
With Search_Range
Set c = .Find( _
what:=Find_Item, _
LookIn:=LookIn, _
LookAt:=LookAt, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=MatchCase, _
searchformat:=False) 'Delete this term for XL2000 and earlier
If Not c Is Nothing Then
Set Find_All = c
firstAddress = c.Address
Do
Set Find_All = Union(Find_All, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Function
JKwan
07-27-2016, 11:45 AM
Well, in you original post, you only ask for a pop up. Well, that is what I gave you.
JKwan
07-27-2016, 11:53 AM
here is the update code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, a, b, c As String
Dim Found As Range
Set Found = Find_All(Range("E9"), Worksheets("ER100_Activation_Configuration").Range("E11:E100"), , xlWhole)
If Not Found Is Nothing Then
Select Case MsgBox("Found", vbYesNoCancel)
Case vbYes
MsgBox "replace data"
Case vbNo
MsgBox "Duplicate data"
Case vbCancel
MsgBox "Cancel update"
End Select
End If
Ln = 7
Set sh1 = Sheets("Data_Entry")
x = Mid(sh1.Range("E431"), 5, Ln)
With Range("E431")
.Value = x
.NumberFormat = WorksheetFunction.Rept("0", Ln)
End With
Set sh1 = Sheets("Data_Entry")
If sh1.Range("S448") = "N" Or sh1.Range("S448") = "ONT" Or sh1.Range("S448") = "PON" Then
b = "3Spring"
Else: sh1.Range("S448") = "Nest3"
b = "4Spring"
End If
If sh1.Range("E448") = "2858097400100" Then
c = "PS100"
Else: sh1.Range("E448") = "2858041501100"
c = "PS60"
End If
a = Array(sh1.Range("E19").Value, sh1.Range("E9").Value, sh1.Range("E7").Value, Mid(sh1.Range("E7"), 10, 4), sh1.Range("M446").Value, sh1.Range("O9").Value, _
sh1.Range("E434").Value, Mid(sh1.Range("E434"), 5, 7), sh1.Range("S444").Value, sh1.Range("E440").Value, Mid(sh1.Range("E440"), 5, 7), _
sh1.Range("E448").Value, c, sh1.Range("S448").Value, b)
With Sheets("ER100_Activation_Configuration").Cells(Rows.Count, 4).End(xlUp).Offset(1)
.Resize(, 21).Value = a
.Resize(, 21).NumberFormat = "0"
.Offset(, -2).Value = .Row() - 2
.Offset(, -1).Value = Format(Now(), "mm-dd-yy")
End With
End Sub
Function Find_All(Find_Item As Variant, Search_Range As Range, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlPart, _
Optional MatchCase As Boolean = False) As Range
Dim c As Range, firstAddress As String
Set Find_All = Nothing
With Search_Range
Set c = .Find( _
what:=Find_Item, _
LookIn:=LookIn, _
LookAt:=LookAt, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=MatchCase, _
searchformat:=False) 'Delete this term for XL2000 and earlier
If Not c Is Nothing Then
Set Find_All = c
firstAddress = c.Address
Do
Set Find_All = Union(Find_All, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Function
Master_Viper
07-27-2016, 11:54 AM
Hi JKwan,
How to do that, like what I've said in my post number 3.
JKwan
07-27-2016, 12:44 PM
Well, it will be up to you. I gave you the frame work / structure for you. All you have to do is put the proper coding into the sections
Master_Viper
07-27-2016, 12:58 PM
Hello JKwan,
Tried your code above. But when I click the Yes, No and Cancel button the data from Data_Entry sheet are just copied to ER100_Activation_Configuration sheet.
Below are the following conditions:
1. When I click the "Yes" button the data at ER100_Activation_Configuration should be replaced.
2. When I click the "No" button the data at ER100_Activation_Configuration should be duplicated.
3. When I click the "Cancel" button it will end/quit the function.
Note: The below code is working when there is already data exist in the ER100_Activation_Configuration sheet. But if new data the the code is not working when I click the Update button in Data_Entry sheet.
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, a, b, c As String
Dim Msg As String, Ans As Variant
Dim Found As Range
Set Found = Find_All(Range("E19"), Worksheets("ER100_Activation_Configuration").Range("D11:D100"), , xlWhole)
If Not Found Is Nothing Then
Msg = MsgBox("Would you like to replace existing data?", vbYesNo, "Found SEMI PN")
'Found = MsgBox("File already exist. Do you want to replace?", vbYesNoCancel, "Found SEMI PN")
Ans = MsgBox(Msg, vbYesNo)
Select Case Ans
Case vbYes
Range("E19").Select
Selection.Copy
'Range("L7").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
'Range("I4").Select
'ActiveSheet.Range("L6").Value = Range("L6").Value + 7
Ln = 7
Set sh1 = Sheets("Data_Entry")
x = Mid(sh1.Range("E431"), 5, Ln)
With Range("E431")
.Value = x
.NumberFormat = WorksheetFunction.Rept("0", Ln)
End With
Set sh1 = Sheets("Data_Entry")
If sh1.Range("S448") = "N" Or sh1.Range("S448") = "ONT" Or sh1.Range("S448") = "PON" Then
b = "3Spring"
Else: sh1.Range("S448") = "Nest3"
b = "4Spring"
End If
If sh1.Range("E448") = "2858097400100" Then
c = "PS100"
Else: sh1.Range("E448") = "2858041501100"
c = "PS60"
End If
a = Array(sh1.Range("E19").Value, sh1.Range("E9").Value, sh1.Range("E7").Value, Mid(sh1.Range("E7"), 10, 4), sh1.Range("M446").Value, sh1.Range("O9").Value, _
sh1.Range("E434").Value, Mid(sh1.Range("E434"), 5, 7), sh1.Range("S444").Value, sh1.Range("E440").Value, Mid(sh1.Range("E440"), 5, 7), _
sh1.Range("E448").Value, c, sh1.Range("S448").Value, b)
With Sheets("ER100_Activation_Configuration").Cells(Rows.Count, 4).End(xlUp).Offset(1)
.Resize(, 21).Value = a
.Resize(, 21).NumberFormat = "0"
.Offset(, -2).Value = .Row() - 2
.Offset(, -1).Value = Format(Now(), "mm-dd-yy")
End With
GoTo Quit:
End Select
Quit:
End If
End Sub
Master_Viper
07-28-2016, 08:56 AM
Hello Expert,
Please help me configure the above code.
Thanks in advance!
JKwan
07-28-2016, 09:28 AM
ok, give this a go. I don't know how you handle multiple occurances (since you did not mention). It looks for the first occurance and does what its told
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, a, b, c As String
Dim Found As Range
Set Found = Find_All(Range("E9"), Worksheets("ER100_Activation_Configuration").Range("E11:E100"), , xlWhole)
If Not Found Is Nothing Then
Select Case MsgBox("Found", vbYesNoCancel)
Case vbYes
MsgBox "replace data"
Ln = 7
Set sh1 = Sheets("Data_Entry")
x = Mid(sh1.Range("E431"), 5, Ln)
With Range("E431")
.Value = x
.NumberFormat = WorksheetFunction.Rept("0", Ln)
End With
Set sh1 = Sheets("Data_Entry")
If sh1.Range("S448") = "N" Or sh1.Range("S448") = "ONT" Or sh1.Range("S448") = "PON" Then
b = "3Spring"
Else: sh1.Range("S448") = "Nest3"
b = "4Spring"
End If
If sh1.Range("E448") = "2858097400100" Then
c = "PS100"
Else: sh1.Range("E448") = "2858041501100"
c = "PS60"
End If
a = Array(sh1.Range("E19").Value, sh1.Range("E9").Value, sh1.Range("E7").Value, Mid(sh1.Range("E7"), 10, 4), sh1.Range("M446").Value, sh1.Range("O9").Value, _
sh1.Range("E434").Value, Mid(sh1.Range("E434"), 5, 7), sh1.Range("S444").Value, sh1.Range("E440").Value, Mid(sh1.Range("E440"), 5, 7), _
sh1.Range("E448").Value, c, sh1.Range("S448").Value, b)
With Sheets("ER100_Activation_Configuration").Cells(Found.Row, 4)
.Resize(, 21).Value = a
.Resize(, 21).NumberFormat = "0"
.Offset(, -2).Value = .Row() - 2
.Offset(, -1).Value = Format(Now(), "mm-dd-yy")
End With
Case vbNo
MsgBox "duplicate data"
Ln = 7
Set sh1 = Sheets("Data_Entry")
x = Mid(sh1.Range("E431"), 5, Ln)
With Range("E431")
.Value = x
.NumberFormat = WorksheetFunction.Rept("0", Ln)
End With
Set sh1 = Sheets("Data_Entry")
If sh1.Range("S448") = "N" Or sh1.Range("S448") = "ONT" Or sh1.Range("S448") = "PON" Then
b = "3Spring"
Else: sh1.Range("S448") = "Nest3"
b = "4Spring"
End If
If sh1.Range("E448") = "2858097400100" Then
c = "PS100"
Else: sh1.Range("E448") = "2858041501100"
c = "PS60"
End If
a = Array(sh1.Range("E19").Value, sh1.Range("E9").Value, sh1.Range("E7").Value, Mid(sh1.Range("E7"), 10, 4), sh1.Range("M446").Value, sh1.Range("O9").Value, _
sh1.Range("E434").Value, Mid(sh1.Range("E434"), 5, 7), sh1.Range("S444").Value, sh1.Range("E440").Value, Mid(sh1.Range("E440"), 5, 7), _
sh1.Range("E448").Value, c, sh1.Range("S448").Value, b)
With Sheets("ER100_Activation_Configuration").Cells(Rows.Count, 4).End(xlUp).Offset(1)
.Resize(, 21).Value = a
.Resize(, 21).NumberFormat = "0"
.Offset(, -2).Value = .Row() - 2
.Offset(, -1).Value = Format(Now(), "mm-dd-yy")
End With
Case vbCancel
Exit Sub
End Select
End If
End Sub
Function Find_All(Find_Item As Variant, Search_Range As Range, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlPart, _
Optional MatchCase As Boolean = False) As Range
Dim c As Range, firstAddress As String
Set Find_All = Nothing
With Search_Range
Set c = .Find( _
what:=Find_Item, _
LookIn:=LookIn, _
LookAt:=LookAt, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=MatchCase, _
searchformat:=False) 'Delete this term for XL2000 and earlier
If Not c Is Nothing Then
Set Find_All = c
firstAddress = c.Address
Do
Set Find_All = Union(Find_All, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Function
Master_Viper
07-28-2016, 09:38 AM
He JKWan,
Your great, Thanks a lot.....
Master_Viper
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.