Page 1 of 2 12 LastLast
Results 1 to 15 of 22
  1. #1
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    FIND DUPLICATE (2000 sr 1)

    This script export from Excel sheet into an MDB table.
    My problem is:

    To controll duplicate from column S of the sheet and filed SRVIZIO of the table TOTALE.
    Column S and field servizio are unique ID

    During the import into access if alreday existis in the field SERVIZIO a line identified with the same value of column S to be exported go to the next line of the sheet and not import the already line already existis into table of MDB...

    http://www.gssitaly.com/sheet_totale.zip
    http://www.gssitaly.com/prova.zip

    I hope of to have been clear

    Sub ADO_TOTALE1()
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    Dim rsFind As ADODB.Recordset
    Set cn = New ADODB.Connection

    Set rs = New Recordset
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=E:MACROL0785-AUTPROVA.MDB;"
    Set rs = New ADODB.Recordset
    rs.Open "TOTALE", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    r = 7 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0
    With rs
    .AddNew ' create a new record
    'add values to each field in the record
    Sheets("L0785_TOTALE").Select
    .Fields("DATA_CONT") = Range("A" & r).Value
    .Fields("DIP") = Range("B" & r).Value
    .Fields("COD_BATCH") = Range("C" & r).Value
    .Fields("C_C") = Range("D" & r).Value
    .Fields("NOMINATIVO") = Range("E" & r).Value
    .Fields("CAUS") = Range("F" & r).Value
    .Fields("DARE") = Range("G" & r).Value
    .Fields("AVERE") = Range("H" & r).Value
    .Fields("VAL") = Range("I" & r).Value
    .Fields("SPORT_MIT") = Range("J" & r).Value
    .Fields("ANOM") = Range("K" & r).Value
    .Fields("DESCR") = Range("L" & r).Value
    .Fields("CRO") = Range("M" & r).Value
    .Fields("ABI") = Range("N" & r).Value
    .Fields("CAB") = Range("O" & r).Value
    .Fields("PAG_IMP") = Range("P" & r).Value
    .Fields("NR_ASS") = Range("Q" & r).Value
    .Fields("MT") = Range("R" & r).Value
    .Fields("SERVIZIO") = Range("S" & r).Value
    .Fields("NOTE_BOU") = Range("T" & r).Value
    .Fields("SPESE") = Range("U" & r).Value
    .Fields("DATA_ATT") = Range("V" & r).Value
    .Fields("COD") = Range("W" & r).Value
    .Fields("NOTA_LIB") = Range("X" & r).Value
    .Update ' stores the new record
    End With

    r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    End Sub

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    Try this: after the line With rs, insert these lines:

    rs.MoveFirst
    rs.Find "SERVIZIO = " & Chr(34) & Range("S" & r).Value & Chr(34)
    If rs.EOF = True Then

    and below the line .Update, above End With, insert

    End If

    The code tests if the value of SERVIZIO can be found in the table. If it is NOT found, the EOF property of the recordset will be True. A new record is only added if this EOF is True.

  3. #3
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    AH!AH! sorry for "You asked almost the same question in post 425198. The reply in that thread can be applied to this one too, so to avoid further duplication, I will lock this thread." I make many attention for the future...

    But thath modify consider if the Table of Mdb is Empty?
    Because i have start the new macro with a empty Table and nobody record in the f

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    It shouldn't matter whether the table is empty or not.

  5. #5
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    Hans have you tested?
    I have modifyin this mode is correct:
    <font face="Script MT Bold">Sub ADO_CDI_50_PROVA_HANSV()
    ' exports data from the active worksheet to a table in an Access database
    ' this procedure must be edited before use
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    Dim rsFind As ADODB.Recordset

    ' connect to the Access database
    Set cn = New ADODB.Connection

    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=E:MACROL0785-AUTPROVA.MDB;"
    ' "Data Source=D:PROVAPROVA.MDB;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "CDI_50", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    ' all records in a table
    r = 7 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0
    ' repeat until first empty cell in column A
    'If Not AlreadyExists(rs, "SERVIZIO", Range("S" & r).Text) Then
    rs.AddNew ' create a new record
    'End If
    With rs
    rs.MoveFirst
    rs.Find "SERVIZIO = " & Chr(34) & Range("S" & r).Value & Chr(34)
    If rs.EOF = True Then
    'add values to each field in the record
    Sheets("L0785_CDI_50").Select
    .Fields("DATA_CONT") = Range("A" & r).Value
    .Fields("DIP") = Range("B" & r).Value
    .Fields("COD_BATCH") = Range("C" & r).Value
    .Fields("C_C") = Range("D" & r).Value
    .Fields("NOMINATIVO") = Range("E" & r).Value
    .Fields("CAUS") = Range("F" & r).Value
    .Fields("DARE") = Range("G" & r).Value
    .Fields("AVERE") = Range("H" & r).Value
    .Fields("VAL") = Range("I" & r).Value
    .Fields("SPORT_MIT") = Range("J" & r).Value
    .Fields("ANOM") = Range("K" & r).Value
    .Fields("DESCR") = Range("L" & r).Value
    .Fields("CRO") = Range("M" & r).Value
    .Fields("ABI") = Range("N" & r).Value
    .Fields("CAB") = Range("O" & r).Value
    .Fields("PAG_IMP") = Range("P" & r).Value
    .Fields("NR_ASS") = Range("Q" & r).Value
    .Fields("MT") = Range("R" & r).Value
    .Fields("SERVIZIO") = Range("S" & r).Value
    .Fields("NOTE_BOU") = Range("T" & r).Value
    .Fields("SPESE") = Range("U" & r).Value
    .Fields("DATA_ATT") = Range("V" & r).Value
    .Fields("COD") = Range("W" & r).Value
    .Fields("IMPORTO") = Range("X" & r).Value
    .Update ' stores the new record
    End If
    End With

    r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    End Sub

    </font face=script>

    I have this message:

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    Why have you removed the following line?

    .AddNew ' create a new record

    Please re-insert it below the line

    If rs.EOF = True Then

  7. #7
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    Hans please i am "OUT OF MEMORY" attache in txt file the complete sacript with your modify...
    Tks as usual

  8. #8
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    no...

  9. #9
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    You don't believe in doing anything yourself, do you? <img src=/S/grin.gif border=0 alt=grin width=15 height=15>

    See attached text file.

  10. #10
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    Peraphs i am stupid but the result is the same.
    please test with this (on this file i have tested your macro):

    http://www.gssitaly.com/prova1.zip
    http://www.gssitaly.com/l0785_totale.zip

    1)
    I have deleted all record in the table totale.
    To test it import first, after re-import and see the macro not consider the record already imported.
    2)
    the old problem if i import from sheet, with a blank table, persit...

  11. #11
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    For some reason, the Find method does not work correctly; I don't know enough about ADO to understand why. The Seek method does work, but it requires that you set an index on the SERVIZIO field in the Totale table. I have attached a zip file with the modified spreadsheet and database. The code works on my PC, but it is VERY slow - the first time, it took almost a minute to transfer all 1908 records. The second time round (no new data) it was almost instantaneous.

    Notes:
    1. I removed a lot of data from the spreadsheet, and also deleted the other tables in the database. There is no need to include all data all the time. As you see, the spreadsheet and database together can be zipped to 41 KB. That is much more convenient to download than 544 KB. But don't overwrite your own files with these!
    2. Don't forget to substitute the correct path to the database in the code.

  12. #12
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    wowh!
    Work fine... tks for patience.
    But to eliminate the "flipping" during the import is possible tu use applicatation screen... TRUE FALSE ecc....

  13. #13
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    Add this line near the beginning of the procedure:

    <code> Application.ScreenUpdating = False</code>

    and this near the end:

    <code> Application.ScreenUpdating = True</code>

  14. #14
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    Sub Test()
    Dim t As Single
    t = Timer
    ADO_TOTALE_HANDY
    t = Timer - t
    Debug.Print "Time: " & t
    End Sub

    ... but this macro not is important for my question, what is....?
    Peraphs yiou have make a test to misure the time of importing.(boh!)
    I have understand onr not?
    If yes, my IQ in VBA is +1 (old -1)
    ;-):-)

  15. #15
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: FIND DUPLICATE (2000 sr 1)

    You can delete the Test procedure; I created it only to see how much time ADO_TOTALE_HANDY takes to run.

Page 1 of 2 12 LastLast

Posting Permissions

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