VBA question, how to create a warning if inputted data exists on separate data sheet

[jsmith2094]

HI,

I have a spreadsheet which allows users to input data on Sheet1 and then when they press submit it transfers the data to a database sheet called Sheet2

that part works fine but I need to have a macro to check Sheet2 first to see if any of the data from Sheet 1 has already been submitted and if it has to display a message to say this data has already been submitted and then for the macro to stop as I have 2 other macros running.

this is what I have so far but it only displays a message if the user does not input anything, if the user inputs data it continues to run without a warning if the data is already on Sheet 2

also

On Sheet 1 the data is inputted into column D rows 13 to 16 but on the below macro if I want to check multiple cells such as FindWhat = Worksheets("Sheet1").Range("D13:D16").Value

it gives me a runtime error.

Sub Procedure1()

Dim FoundCell As Range
Dim FindWhat As String
    FindWhat = Worksheets("Sheet1").Range("D13").Value
    Set FoundCell = Worksheets("Sheet2").Range("A:A").Find(What:=FindWhat, LookAt:=xlWhole)
    
    If Not FoundCell Is Nothing Then
        MsgBox "Found " & FindWhat & " Data already Submitted to the Fraud Team!"
        Exit Sub
    End If
    
End Sub

any suggestions?

 

[Joe4]

Welcome to the Board!

Try this:

Sub Procedure1()

    Dim FoundCell As Range
    Dim FindWhat As String
    Dim cell As Range

    For Each cell In Worksheets("Sheet1").Range("D13:D16")
        FindWhat = cell.Value
        Set FoundCell = Worksheets("Sheet2").Range("A:A").Find(What:=FindWhat, LookAt:=xlWhole)
    
        If Not FoundCell Is Nothing Then
            MsgBox "Found " & FindWhat & " Data already Submitted to the Fraud Team!"
        End If
    Next cell
    
End Sub

 

[jsmith2094]

@Joe4

Thanks so much for the super quick reply.

That works perfect.

I only have 1 more question

I have multiple macros running when the submit button is pressed. currently if the same data exists on sheet2 and it gives the warning, the other 2 macros I have keep running.

how do i get the macro to stop when a user gets the warning message?

 

[Joe4]

I have multiple macros running when the submit button is pressed. currently if the same data exists on sheet2 and it gives the warning, the other 2 macros I have keep running.

That seems rather odd/curious. What are these other macros doing?

how do i get the macro to stop when a user gets the warning message?

You can add the "Exit Sub" statement back in, like you had in the original code.
But then it will just stop at the first value it finds, and not check the other ones.
I am not sure if that is what you want to happen or not.

 

[jsmith2094]

@Joe4

See my full code below, I have procedure 1,2 & 3 . Number 1 is the code you helped me with to check to see if the data the user is trying to submit already exists on sheet2, if the data is not on sheet 2 it will then move on to procedure 2 which will copy the data that was submitted on the form and copy it to sheet 2 then procedure 3 will create a copy of sheet1 and email it to another department.

the problem I have is that if the data in step 1 is found on sheet2 it will display a message saying it exists already but when you dismiss the message it continues to move to procedure 2 and 3 , I would like if possible that if procedure 1 finds existing data on sheet 2 for procedure 2 and 3 not to run . I only want them to run if the data is not on sheet2

Sub RunAllMacros()
Procedure1
Procedure2
Procedure3
End Sub
 
Sub Procedure1()

    Dim FoundCell As Range
    Dim FindWhat As String
    Dim cell As Range

    For Each cell In Worksheets("Sheet1").Range("D13:D16")
        FindWhat = cell.Value
        Set FoundCell = Worksheets("Sheet2").Range("A:A").Find(What:=FindWhat, LookAt:=xlWhole)
    
        If Not FoundCell Is Nothing Then
            MsgBox "Found " & FindWhat & " Data already Submitted to the Fraud Team!"
        End If
    Next cell
    
End Sub


Sub Procedure2()
'The active cell is the FIRST cell in a selected range
'with range A6:A8 selected, ActiveCell =A6
'ActiveCell.Row is the row number of that cell = 6
'Selection.Rows.Count = the count of rows in the selected range = 3  (rows 6,7,8)
'A1:S1 is offset by 5 rows ( ie ActiveCell.Row 6 MINUS 1 = 5)  = A6:S6
'A6:S6 is then resized to 3 rows = A6:S8
' that range is copied
    Range("D13:G15").Copy
'standard technique to find last cell in column A and then offseting by one row
' same as putting cusor in cell A1048576 followed by {END}{UP arrow}{DOWN arrow}
    With Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
'paste everything including formula
        .PasteSpecial (xlPasteAll)
    End With
End Sub
 
Sub Procedure3()
Dim oApp As Object
    Dim oMail As Object
    Dim LWorkbook As Workbook
    Dim LFileName As String

    'Turn off screen updating
    Application.ScreenUpdating = False

    'Copy the active worksheet and save to a temporary workbook
    ActiveSheet.Copy
    Set LWorkbook = ActiveWorkbook

    'Create a temporary file in your current directory that uses the name
    ' of the sheet as the filename
    LFileName = LWorkbook.Worksheets(1).Name
    On Error Resume Next
    'Delete the file if it already exists
    Kill LFileName
    On Error GoTo 0
    'Save temporary file
    LWorkbook.SaveAs FileName:="Temp_Please_Delete"

    'Create an Outlook object and new mail message
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    
    'Set mail attributes (uncomment lines to enter attributes)
    ' In this example, only the attachment is being added to the mail message
    With oMail
        .To = "john@mail.com"
        .CC = "john@mail.com"
        .Subject = "Data sheet"
        .HTMLBody = "HI  team" & "<br>" & "<br>" & "Please see the attched with information" & "<br>" & "<br>" & "Thanks John"
        .Attachments.Add LWorkbook.FullName
        .Send
    End With

    'Turn back on screen updating
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing

End Sub

 

[Joe4]

That is because you are telling all three procedures to run, no matter what. None of the procedures are looking at the other one.
What you can do is create a Global Variable (that is accessible in ALL procedures), and set it in the first procedure (i.e. indicating whether to run the other two or not).
You can then use an IF statement in your "RunAllMacros" procedure, checking the value of this Global Variable, and then indicating whether or not to run the other two procedures.

 

[jsmith2094]

@Joe4

I'm not that advanced with VBA yet, I have been looking around online and cant seem to know how to achieve this?

 

[Joe4]

See the following edits:

Public RunProcs As String


Sub RunAllMacros()

    Procedure1
   
    If RunProcs = "Yes" Then
        Procedure2
        Procedure3
    End If
   
End Sub
 

Sub Procedure1()

    Dim FoundCell As Range
    Dim FindWhat As String
    Dim cell As Range

    For Each cell In Worksheets("Sheet1").Range("D13:D16")
        FindWhat = cell.Value
        Set FoundCell = Worksheets("Sheet2").Range("A:A").Find(What:=FindWhat, LookAt:=xlWhole)
   
        If Not FoundCell Is Nothing Then
            MsgBox "Found " & FindWhat & " Data already Submitted to the Fraud Team!"
            Exit Sub
        End If
    Next cell
   
'   Set RunProcs to Yes
    RunProcs = "Yes"
   
End Sub

 

[jsmith2094]

@Joe4

I tried the above code you mentioned and cleared the contents of sheet2 , when I run the macro it gives me the warning message saying the data exists on sheet 2 and the macro stops but the Sheet2 has nothing in it so im not sure why its not running the rest of the macros.

I only need it to stop if the data does exist on sheet2 , if it is new data it should run procedure 2 and 3 as normal?

 

[dmt32]

the problem I have is that if the data in step 1 is found on sheet2 it will display a message saying it exists already but when you dismiss the message it continues to move to procedure 2 and 3 , I would like if possible that if procedure 1 finds existing data on sheet 2 for procedure 2 and 3 not to run . I only want them to run if the data is not on sheet2

You could make procedure1 a Function that returns a boolean value (True / False) and only run the other procedures if it returns False

Try this update

Function Procedure1() As Boolean
   
    Dim FoundCell   As Range
    Dim FindWhat    As String
    Dim cell        As Range
   
    For Each cell In Worksheets("Sheet1").Range("D13:D16")
        FindWhat = cell.Value
       
        Set FoundCell = Worksheets("Sheet2").Range("A:A").Find(What:=FindWhat, LookAt:=xlWhole)
       
        If Not FoundCell Is Nothing Then
            MsgBox "Found " & FindWhat & Chr(10) & " Data already Submitted To the Fraud Team!", 48, "Record Exists"
            Procedure1 = True
            Exit For
        End If
    Next cell
  
End Function

Updated calling code

Sub RunAllMacros()
    If Procedure1 Then Exit Sub
    Procedure2
    Procedure3
End Sub

Dave