Results 1 to 11 of 11
  1. #1
    skydivetom is offline Competent Performer
    Windows 8 Access 2010 64bit
    Join Date
    Feb 2019
    Posts
    460

    Need VBA to convert a 7-step cleanup process into single VBA function

    Hello:



    In a previous post, expert Ajax helped me develop a function (VBA) for keyword extraction. The function works beautifully!! See original post at: https://www.accessforums.net/showthread.php?t=82987

    Please see attache sample data base and review query "qryExampleDataKeywordExtraction". The output of the function is listed in the 2nd column in the query.

    Now, in the next step of my data analsyis, I need to **clean up" the found keywords. Currently, I'm doing it in MS-Excel... it is a *7-step process* and can be very tedious particularly when I have hundreds of records (vs. just the 4 sample records).

    I have illustrated the 7-step cleanup process (see attached XLS) and included separate tabs for each step.

    Step 1: Copy/paste results from Access query into tab "Step1_QueryData"
    Step 2: Perform text delimitation on column A. In this case, the max # of columns (from 1st record) go all the way to column M. However, I have seen where columns are populated all the way to column AC:
    Step 3: Cut/paste all columns values (B:M) into single column A.
    Step 4: Apply ASC order (w/o column header)
    Step 5: After sorting, delete all header & NULL values
    Step 6: Remove empty spaces before key word (in Excel, I used the TRIM function)
    Step 7: Remove duplicates and (if necessary) sort again.

    My question: Can this 7-step "cleanup process) currently in Excel also be applied in Access via some VBA? Ultimately, it would make work life so much easier if I had another function which would be applied to the existing query and output the 17 distinct keywords (values) as currently illustrated in "Step7_RemoveDuplicates". If so, what would the VBA look like?

    Thank you for your help in advance!

    EEH
    Attached Files Attached Files

  2. #2
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2016
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    15,320
    Tom,

    This routine should do what you're asking.

    It uses the output from your query, builds a table TblTest
    MyID auto PK
    FieldRequired text (indexed no duplicates)

    Code:
    ' ----------------------------------------------------------------
    ' Procedure Name: GetDistinctStrings
    ' Purpose: Routine to process the result of query "qryExampleDataKeywordExtraction" and
    ' populate a table with Distinct string values.
    ' Procedure Kind: Sub
    ' Procedure Access: Public
    ' Author: Jack
    ' Date: 23-Feb-21
    ' ----------------------------------------------------------------
    Sub GetDistinctStrings()
    10        On Error GoTo GetDistinctStrings_Error
    
              Dim TxtArr() As String
              Dim i As Integer
              Dim db As DAO.Database
              Dim rsIN As DAO.Recordset
              Dim rsOUT As DAO.Recordset
              Dim CreateTableSQL As String
              Dim CreateIndexSQL As String
              
    20        CreateTableSQL = " create table Tbltest (MyID Counter,FieldRequired text(30) " _
                  & " CONSTRAINT MyId PRIMARY KEY );"
                  
    30        CreateIndexSQL = "CREATE UNIQUE INDEX CustID " _
                  & "ON TblTest(FieldRequired) ;"
                
    40        Set db = CurrentDb
    50        CurrentDb.Execute CreateTableSQL, dbFailOnError
    
    60        CurrentDb.Execute CreateIndexSQL, dbFailOnError
    
    70        Set rsIN = db.OpenRecordset("qryExampleDataKeywordExtraction", dbReadOnly)
    80        Set rsOUT = db.OpenRecordset("TblTest")
    90        Do While Not rsIN.EOF
    100           Debug.Print rsIN!Extraction
    110           TxtArr = Split(rsIN!Extraction, ";")
    120           For i = 0 To UBound(TxtArr)
    130               rsOUT.AddNew
    140               rsOUT!fieldRequired = Trim(TxtArr(i))
    150               rsOUT.Update
    160           Next i
                  'Clear th array
    170           For i = 0 To UBound(TxtArr)
    180               TxtArr(i) = ""
    190           Next i
    200           rsIN.MoveNext
    210       Loop
    
    220       On Error GoTo 0
    GetDistinctStrings_Exit:
    230       Application.RefreshDatabaseWindow
    240       Exit Sub
    
    
    GetDistinctStrings_Error:
    250       If Err.Number = 3022 Then
    260           Resume Next
    270       Else
    280           MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetDistinct, line " & Erl & "."
    290           GoTo GetDistinctStrings_Exit
    300       End If
     
    End Sub

    Result:

    FieldRequired
    1st_line
    field_name
    first_line_supervisor
    foreign_key
    is_null
    mshp_id
    mshp_oneliner
    one_liner
    pers_1st_line_supervisor
    PERS_DAYS_ON_QUARTERS
    pers_employment_status1_id
    pers_employment_status2_id
    pers_factor_flag
    pers_id
    pers_injured_flag
    pers_operator_flag
    sort_number

  3. #3
    skydivetom is offline Competent Performer
    Windows 8 Access 2010 64bit
    Join Date
    Feb 2019
    Posts
    460
    orange -- awesome, I was able to generate the same list (based on the sample data).

    Here's the thing though... based on my *actual data*, my query expression apparently returns some values/conversions and interprets them as "#Error".

    I tried the following to replace the #Error in my query with the following modified expression:

    Code:
    Extraction: =IIf(IsError(listKeywords([raw data]),"", listKeywords([raw data])
    Unfortunately, my syntax appears to be wrong... also, I'm not even sure if that's actually causing the error when running your VBA function with the actual data. Ultimately, I get the error 3464 message. Please see attached both snapshots of a piece of actual data as well as the VBA error message.

    Any recommendations how this could be modified? Unfortunately, I cannot post my actual data set in this forum. Thank you.

    Tom
    Attached Thumbnails Attached Thumbnails ActualDataIncludes Errors.JPG   Error3464.JPG  

  4. #4
    Gicu's Avatar
    Gicu is offline VIP
    Windows 10 Access 2010 32bit
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    2,087
    You're getting the #Error on the records with no data, simply add Is Not Null in the Criteria Row for the [Raw Data] field in your query.

    Cheers,
    Vlad Cucinschi
    MS Access Developer
    http://forestbyte.com/

  5. #5
    skydivetom is offline Competent Performer
    Windows 8 Access 2010 64bit
    Join Date
    Feb 2019
    Posts
    460
    Gicu -- ok, great -- one step further in the process. All null values are no longer included in the query.

    However, when executing the Sub GetDistinctStrings(), I now get the a different error (see attached JPG).

    How should be function be modified to ensure I won't get this error?
    Attached Thumbnails Attached Thumbnails Error3163.JPG  

  6. #6
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2016
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    15,320
    I set the size of the field FieldRequired in the TblTest to 30. You could adjust it to 60 or 80 ???
    Code:
    CreateTableSQL = " create table Tbltest (MyID Counter,FieldRequired text(30) " _
                  & " CONSTRAINT MyId PRIMARY KEY );"

  7. #7
    skydivetom is offline Competent Performer
    Windows 8 Access 2010 64bit
    Join Date
    Feb 2019
    Posts
    460
    orange -- wow... your solution is fantastic!!! It works like a charm.

    As I may have to modify/add data in the future, is there any chance you could provide a few comments on what the individual lines of code do... it'll help me better understand the procedure.

    Thank you so very much!

    Tom

    P.S. Is there a way to throw a message box which indicates how many records/distinct values were created in Tbltest?

  8. #8
    skydivetom is offline Competent Performer
    Windows 8 Access 2010 64bit
    Join Date
    Feb 2019
    Posts
    460
    orange -- wow... your solution is fantastic!!! It works like a charm.

    As I may have to modify/add data in the future, is there any chance you could provide a few comments on what the individual lines of code do... it'll help me better understand the procedure.

    Thank you so very much!

    Tom

    P.S. Is there a way to throw a message box which indicates how many records/distinct values were created in Tbltest?

  9. #9
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2016
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    15,320
    Sure.
    Here's the updated code with comments and the requested message box of record counts.

    Code:
    ' ----------------------------------------------------------------
    ' Procedure Name: GetDistinctStrings
    ' Purpose: Routine to process the result of query "qryExampleDataKeywordExtraction" and
    ' populate a table with Distinct string values.
    ' Show user records counts in and out when finished.
    ' Procedure Kind: Sub
    ' Procedure Access: Public
    ' Author: Jack
    ' Date: 23-Feb-21
    ' ----------------------------------------------------------------
    Sub GetDistinctStrings()
    10        On Error GoTo GetDistinctStrings_Error
    
              Dim TxtArr() As String       'array to hold extracted strings
              Dim i As Integer             'utility counter for processing array elements
              Dim jCnt As Integer          'counter of input records
              Dim db As DAO.Database
              Dim rsIN As DAO.Recordset    'input
              Dim rsOUT As DAO.Recordset   'output
              Dim CreateTableSQL As String 'sql to create table tblTest
              Dim CreateIndexSQL As String 'sql to create index no duplicates
              
    20        CreateTableSQL = " create table Tbltest (MyID Counter,FieldRequired text(130) " _
                  & " CONSTRAINT MyId PRIMARY KEY );"
                  
    30        CreateIndexSQL = "CREATE UNIQUE INDEX CustID " _
                  & "ON TblTest(FieldRequired) ;"
                
    40        Set db = CurrentDb
    50        CurrentDb.Execute CreateTableSQL, dbFailOnError  'execute the create Table
    
    60        CurrentDb.Execute CreateIndexSQL, dbFailOnError  'execute the create index
    
    70        Set rsIN = db.OpenRecordset("qryExampleDataKeywordExtraction", dbReadOnly)
    80        Set rsOUT = db.OpenRecordset("TblTest")
    90        Do While Not rsIN.EOF                    'read each input record in loop
    100           jCnt = jCnt + 1                      'increment the inut record count
    110           Debug.Print rsIN!Extraction          'show input record to immediate window
    120           TxtArr = Split(rsIN!Extraction, ";") 'split the input based on ";"
    130           For i = 0 To UBound(TxtArr)          'loop through the array elements
    140               rsOUT.AddNew                     'set up to add record to output
    150               rsOUT!fieldRequired = Trim(TxtArr(i)) 'trim contents of array element
    160               rsOUT.Update                       'add the extracted string to output
    170           Next i
                  'Clear the array
    180           For i = 0 To UBound(TxtArr)           'reset the array to empty
    190               TxtArr(i) = ""
    200           Next i
    210           rsIN.MoveNext                         'move to get the next input record
    220       Loop
    
    230       On Error GoTo 0
    GetDistinctStrings_Exit:
                 'Provide user with record counts in and out
    240       MsgBox "Number of input records processed:  " & jCnt & vbCrLf _
                   & "Number of unique extracted strings: " & DCount("*", "TblTest")
              
    250       Application.RefreshDatabaseWindow          'refresh the database window
    260       rsIN.Close
    270       rsOUT.Close
    280       db.Close
    290       Exit Sub
    
    
    GetDistinctStrings_Error:
    300       If Err.Number = 3022 Then
    310           Resume Next
    320       Else
    330           MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetDistinct, line " & Erl & "."
    340           GoTo GetDistinctStrings_Exit
    350       End If
           
    End Sub

  10. #10
    skydivetom is offline Competent Performer
    Windows 8 Access 2010 64bit
    Join Date
    Feb 2019
    Posts
    460
    Orange -- wow, I'm super-impressed w/ your elegant solution (as well as proving me the comments for the VBA). I'm very thrilled to having this functionality.

    THOUSAND THANKS!!!

    Cheers,
    Tom

  11. #11
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2016
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    15,320
    Happy to help.

    Tom,
    Just an additional comment.

    In these lines
    Code:
    300       If Err.Number = 3022 Then
    310           Resume Next
    Err.Number 3022 indicates an attempt to add a duplicate record/key.
    And, since the FieldRequired has a unique index, when access attempts to
    add a duplicate, the software responds with err 3022 and the error handler
    accepts that error and continues processing (Resume Next).
    Last edited by orange; 02-23-2021 at 06:52 PM.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 2
    Last Post: 10-21-2016, 11:26 AM
  2. Replies: 4
    Last Post: 12-27-2015, 07:38 PM
  3. Macro Single Step Error
    By cfspartan in forum Macros
    Replies: 6
    Last Post: 04-25-2015, 12:05 AM
  4. What function to use this process
    By azhar2006 in forum Forms
    Replies: 2
    Last Post: 10-05-2014, 02:20 PM
  5. multi-step process with click of button
    By pg13Reader in forum Forms
    Replies: 4
    Last Post: 12-12-2011, 11:12 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums - Senior Forums