Results 1 to 10 of 10
  1. #1
    Lounger
    Join Date
    Jul 2014
    Posts
    33
    Thanks
    7
    Thanked 3 Times in 3 Posts

    Data Submit Macro - Preventing Duplication?

    Hi guys!

    I've created a simple form submit sheet which will submit the data into a seperate workbook, save that workbook and close it.

    You can see the code below:
    Code:
       ActiveWindow.SmallScroll Down:=45
        Range("B61:U61").Select
        Selection.Copy
        Workbooks.Open Filename:= _
            "\\Mgltp01-sv\shared\Leeds Helpdesk Management\Data Analyst's Reports\Call Quality Assessment\Call Quality Data.xlsx"
            ActiveWorkbook.Sheets("Raw Data").Activate
        Lastrow = Sheets("Raw Data").Cells(Cells.Rows.Count, "A").End(xlUp).Row
     If Lastrow < 40000 Then
         ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
         Paste:=xlPasteValues
         Application.CutCopyMode = False
         ActiveWorkbook.Save
         ActiveWorkbook.Close
         MsgBox "Your form has successfully been submitted"
    Basically, I wondered if there was a way to put a safety in the macro to prevent duplication? I added the message box as confirmation that the sheet had been submitted which i think is stopping a lot of duplication - but the odd form is slipping through as a duplicate ( I think when Team Leaders are forgetting that they've already submitted it ). I've been filtering the cases out manually but as there are over 400 going in a week it's a task I'd like to be able to give up!

    The form is multiple choice - dropdown boxes are used to insert the answers. Each form has a date and time stamp that should be unique, and each form also has a unique reference number.

    I'd appreciate any help possible on this. If you need to see the workbooks that's not a problem but i will have to add them to the post later as I am currently out of the office.

    Thanks for reading.

    R

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,633
    Thanks
    115
    Thanked 648 Times in 591 Posts
    Rathril,

    I believe this code will perform the check you are looking for. It takes the line of source data and enters it into an array variable then checks the array against each line in the destination sheet. If no matches are found then it will follow your code and paste the data. If a match (duplicate) is found then a message box indicating so will appear and the code stops.

    The code was tested between sheets. If your code is sound then this should work for you

    HTH,
    Maud

    Code:
    Public Sub ChkDups()
    'CODE ASSUMES THAT IT IS RAN FROM THE SOURCE SHEET
    '------------------------------
    'DECLARE AND SET VARIABLES
        Dim s(20)
        Dim StartRow As Integer
        Dim LastRow As Integer
        StartRow = 1 'CHANGE TO FIRST ROW OF DATA IN DESTINATION SHEET
    '------------------------------
    'COPY SOURCE DATA INTO ARRAY VARIABLE (DATA ROW)
        For I = 0 To 19
            s(I) = Cells(6, I + 2)
        Next I
    '------------------------------
    'SELECT RANGE AND COPY DATA
        Range("B61:U61").Select
        Selection.Copy
    '------------------------------
    'OPEN DESTINATION WORKBOOK AND ACTIVAE DESTINATION WORKSHEET
        Workbooks.Open Filename:= _
            "\\Mgltp01-sv\shared\Leeds Helpdesk Management\Data Analyst's Reports\Call Quality Assessment\Call Quality Data.xlsx"
        ActiveWorkbook.Sheets("Raw Data").Activate
    '------------------------------
    'COMPARE SOURCE DATA WITH EACH LINE IN DESTINATION SHEET
        LastRow = ActiveSheet.Cells(Cells.Rows.Count, "A").End(xlUp).Row
        For I = StartRow To LastRow 'CYCLE LINES
            For J = 0 To 19
                If s(J) <> Cells(I, J + 1) Then GoTo Done 'IF NO MATCH THE GO TO NEXT LINE
            Next J
    '------------------------------
    'EACH ARRAY VARIABLE MATCHED THE CORRESPONDING CELL IN A SINGLE ROW
            MsgBox "Duplicate Data"
            Exit Sub
    Done:
    Next I
    '------------------------------
    'NO MATCHING ROWS FOUND. PASTE DATA
    If LastRow < 40000 Then
         ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
         Paste:=xlPasteValues
         Application.CutCopyMode = False
         ActiveWorkbook.Save
         ActiveWorkbook.Close
         MsgBox "Your form has successfully been submitted"
    
    End Sub

  3. The Following User Says Thank You to Maudibe For This Useful Post:

    Rathril (2014-09-23)

  4. #3
    Lounger
    Join Date
    Jul 2014
    Posts
    33
    Thanks
    7
    Thanked 3 Times in 3 Posts
    Hi Maudibe!

    Thanks a lot for your help - I will try the macro out later today and let you know the results.

    R

  5. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,633
    Thanks
    115
    Thanked 648 Times in 591 Posts
    Rathril,

    I tested with data on row 6. Please change the 6 in the11th line to 61:

    s(I) = Cells(61, I + 2)

    otherwise it will be comparing and copying blank data.

    Maud

  6. The Following User Says Thank You to Maudibe For This Useful Post:

    Rathril (2014-09-29)

  7. #5
    Lounger
    Join Date
    Jul 2014
    Posts
    33
    Thanks
    7
    Thanked 3 Times in 3 Posts
    Funnily enough I had my first duplication today and came to ask why that would be! You are definitely efficient, thanks a lot - incidently I'm actually beginning to understand what each line means in these macros so i'm getting somewhere

    R

  8. #6
    Lounger
    Join Date
    Jul 2014
    Posts
    33
    Thanks
    7
    Thanked 3 Times in 3 Posts
    I tested it today and it works perfectly - All I've done is add a line that closes the Data workbook after a duplicate is found

    Thanks again Maudibe you're a star - You and RetiredGeek are geniuses.

    R

  9. #7
    Lounger
    Join Date
    Jul 2014
    Posts
    33
    Thanks
    7
    Thanked 3 Times in 3 Posts
    Hey Maudibe - Just had a couple of ideas...

    Is there a way for me to put in a sense check at the beginning of the script which checks for blank fields and exits the sub ( with a message box stating exactly why... must be clear what kind of mindset the people have filling in the form )

  10. #8
    Lounger
    Join Date
    Feb 2011
    Posts
    28
    Thanks
    0
    Thanked 10 Times in 8 Posts
    If you substitute this section to the following, it will check if there are any blanks and tell the user where the problem is:

    'COPY SOURCE DATA INTO ARRAY VARIABLE (DATA ROW)

    For i = 0 To 19
    s(i) = Cells(61, i + 2)
    If s(i) = "" Then
    MsgBox "There's no data in column " & Chr(66 + i)
    Exit Sub
    End If
    Next i

  11. The Following 2 Users Say Thank You to unclehewie For This Useful Post:

    Maudibe (2014-10-02),Rathril (2014-10-03)

  12. #9
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,633
    Thanks
    115
    Thanked 648 Times in 591 Posts
    I think unclehewie about summed it up! Clever using the ASCII table.

  13. #10
    Lounger
    Join Date
    Jul 2014
    Posts
    33
    Thanks
    7
    Thanked 3 Times in 3 Posts
    Code:
    Public Sub Submit()
    'CODE ASSUMES THAT IT IS RAN FROM THE SOURCE SHEET
    '------------------------------
    'DECLARE AND SET VARIABLES
        Dim s(22)
        Dim StartRow As Integer
        Dim LastRow As Integer
        StartRow = 1 'CHANGE TO FIRST ROW OF DATA IN DESTINATION SHEET
    '------------------------------
    'COPY SOURCE DATA INTO ARRAY VARIABLE (DATA ROW)
     
    For i = 0 To 21
     s(i) = Cells(62, i + 2)
     If s(i) = "" Then
     MsgBox "There's no data in column " & Chr(66 + i)
     Exit Sub
     End If
     Next i 
    '------------------------------
    'SELECT RANGE AND COPY DATA
        Range("B62:Z62").Select
        Selection.Copy
    '------------------------------
    'OPEN DESTINATION WORKBOOK AND ACTIVAE DESTINATION WORKSHEET
        Workbooks.Open Filename:= _
            "\\Mgltp01-sv\shared\Leeds Helpdesk Management\Data Analyst's Reports\Call Quality Assessment\Call Quality Data.xlsx"
        ActiveWorkbook.Sheets("Raw Data").Activate
    '------------------------------
    'COMPARE SOURCE DATA WITH EACH LINE IN DESTINATION SHEET
        LastRow = ActiveSheet.Cells(Cells.Rows.Count, "A").End(xlUp).Row
        For I = StartRow To LastRow 'CYCLE LINES
            For J = 0 To 20
                If s(J) <> Cells(I, J + 1) Then GoTo Done 'IF NO MATCH THE GO TO NEXT LINE
            Next J
    '------------------------------
    'EACH ARRAY VARIABLE MATCHED THE CORRESPONDING CELL IN A SINGLE ROW
            MsgBox "Duplicate Data"
            Exit Sub
    Done:
    Next I
    '------------------------------
    'NO MATCHING ROWS FOUND. PASTE DATA
    If LastRow < 40000 Then
         ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
         Paste:=xlPasteValues
         Application.CutCopyMode = False
         ActiveWorkbook.Save
         ActiveWorkbook.Close
         MsgBox "Your form has successfully been submitted"
    
    End Sub
    Hi guys. The above is how the code looks now... I had to make some (half successful ) modifications as follows:

    Added two new cells for data submitting ( and =NOW() and a Type ) which I figured I could handle, it still submits, checks for duplicates and incomplete questions which is PERFECT so thank you very much for that!

    However.... When it pastes the last cell ( which is the =NOW() ) on the data sheet is being pasted into the raw data sheet with a two column gap?

    It's most definitely not a major issue, other than that it's absolutely fantastic so thanks for your help guys!

    R

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •