PDA

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