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

100"), , 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

100"), , 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

Thread: VBA code for message box popup if data already exist.

Thread Tools

Display

VBA code for message box popup if data already exist.

Posting Permissions