VBA to move all values from n fields into new table with single field

[skydivetom]

Hello:



I would like to develop a VBA routine which moves **all** field values into a single field in a new table.

Background:
- Attached DB has table [00_tbl_RawData] which contains 39 records; across with 7 fields ([A], [B], [C], ..., [G]).
- However, a future data pull may include additional fields, e.g., [H], [I], etc. That said, the number of fields is an unknown factor.
- Some fields may contain NULL values, but there should be AT LEAST 1 value in any field.

Envisioned Process:
1. The VBA routine must scan through all fields EXCEPT the autonumber field [ID].
2. Ideally, the VBA routine then generates a new table [01_tbl_Extract] with a single field, e.g., [VALUES].
3. The raw record count would be equal to 273 (i.e., 7 fields * 39 records).
4. However, given that some fields have NULL values, the actual # of non-null records equals 129. I did this (math) in MS-Excel and manually generated the final product. See table [01_tbl_Extract] for interim results.
5. As you will notice though, the values in [01_tbl_Extract].[VALUES] are *not* DISTINCT.
6. Thus, ultimately, I need to end up with a table [02_tbl_Extract_Distinct].[DISTINCT_VALUES] containing unique values only. **

** Issue with the DISTINCT values:
- Although I need a distinct list of values, I do need to distinguish between lower and upper cases values.
- For example, record #6 in [00_tbl_RawData].[B] contains value = "to". Alternatively, record #11 in [00_tbl_RawData].[B] contains value = "To".
- When reviewing final table [02_tbl_Extract_Distinct].[DISTINCT_VALUES], record #96 holds value = "to" but there is no record for "To". Not having all upper/lower case values *may* be an issue later on.

My question:
- Does anyone know of a VBA routine which ultimately generates table [02_tbl_Extract_Distinct] based on source data [00_tbl_RawData]?
- Ideally, I would be able to maintain distinct values, e.g., "to" & "To". However, if too difficult, I might be okay if final table does not distinct between these and I, therefore, have the 102 records as illustrated in [02_tbl_Extract_Distinct].

Thank you,
Tom

[June7]

Did you mean "AT LEAST 1 value in any record" ?

A UNION query can rearrange data to one column.

However, Access is not case dependent by default. Maintaining this would be tricky and I have never tried.

SELECT A AS Values FROM 00_tbl_RawData
UNION SELECT B FROM 00_tbl_RawData
UNION SELECT C FROM 00_tbl_RawData
UNION SELECT D FROM 00_tbl_RawData
UNION SELECT E FROM 00_tbl_RawData
UNION SELECT F FROM 00_tbl_RawData
UNION SELECT G FROM 00_tbl_RawData;

The unique ID field would have to be calculated in subsequent query or write the UNION data to a table.

However, if number of columns is variable, then VBA would have to open recordset, loop through fields referencing their index, save values to another table with field set to not allow duplicates. I know this has been asked before.

[skydivetom]

June7:

I came across a potential solution in another forum. Am I allowed to cross-reference to Bytes.com here? If yes, I can provide more specifics.

[June7]

Yes, please do.

[skydivetom]

Hello experts:

I came across a 10+year old posting in another forum Bytes.com (https://bytes.com/topic/access/answe...ic-union-query).

For full disclosure, I posted a question in that forum, but apparently I can't attach any files which makes it difficult to follow along. I hope I'm not in violation of any rules in Accessforums.net by now posting the question here. If so, please forgive me in advance. Anyhow, here it is...

The solution offered by @Steward Ross is fabulous and perfectly fits my current need. However, I need to slightly tweak the VBA in order to NOT process *string* values vs. *integers* (e.g., quantities) but instead process *string* values.

Instead of reiterating the need, I recommend to briefly scan through Stewards's recommendation.

Next, I replicated the original author's data set and then took Steward's VBA code and placed it into the attached DB "Version_01_Integer".

Upon opening the DB "Version_01_Integer", please do the following:
1. Click on command button "Convert Multi Fields..." in the form (open by default).
2. Compare tables [01_tblSource] and [02_tblDestination].

Again, the outcome is exactly as in the specified requirements. No change is needed in Version_01.

Now, let's review version "Version_02_String"... this is the one I need some help with!!!

I'll summarize the changes I made:
1. With the exception of the autonumber [ID] field, all fields have data type = "Short Text".
2. In the form, I modified the function call start start in 2nd field and include altogether 5 fields:

    blResult = fExtractProductQuantities("01_tblSource", "02_tblDestination", 2, 5, True)

3. I modified table [02_tblDestination] and changed the data type to "Short Text" for [Fieldname] and [Stringvalue].
4. Next, in the module, I modified the following lines of code

        For intFieldCount = 0 To FirstProductFieldNo - 2
            'strSQLCreate = strSQLCreate & rsSource.Fields(intFieldCount).Name & IIf(intFieldCount = 0, " INT ,", " VARCHAR(255), ")              'Original code
            strSQLCreate = strSQLCreate & rsSource.Fields(intFieldCount).Name & IIf(intFieldCount = 0, " VARCHAR(255) ,", " VARCHAR(255), ")
        Next

'strSQLCreate = strSQLCreate & "Product VARCHAR(255), Quantity INT);" 'Original code
strSQLCreate = strSQLCreate & "Fieldname VARCHAR(255), Stringvalue VARCHAR(255));"

Here's the problem though. Upon click the command button in the form, none of the data are never moved into table [02_tblDestination].

My question:
What additional VBA code modifications are necessary so that I can transfer all data across all fields (except the autonumber ID field) into the destination table?

Thank you for your help in advance,
Tom

[June7]

Always courtesy to inform readers of other forum question is posted in.

I have not reviewed the solution you found. I was already working on this code.

Sub GetWords()
Dim rs As DAO.Recordset
Dim x As Integer
Dim strSQL As String
Set rs = CurrentDb.OpenRecordset("SELECT * FROM 00_tbl_RawData WHERE 0=1")
For x = 1 To rs.Fields.Count - 1 'assumes field index 0 is ID field - this is dependent on order of field list in table design
    If x = 1 Then
        strSQL = "SELECT " & rs(x).Name & " AS [Values] FROM 00_tbl_RawData" & vbCrLf
    Else
        strSQL = strSQL & "UNION SELECT " & rs(x).Name & " FROM 00_tbl_RawData" & vbCrLf
    End If
Next
CurrentDb.Execute "DELETE FROM tblExtract"
CurrentDb.Execute "INSERT INTO tblExtract([Values]) SELECT [Values] FROM (" & strSQL & ") WHERE NOT [Values] IS NULL ORDER BY [Values]"
End Sub

However, some words in source have sentence punctuation and that is retained.

Be aware, UNION has limit of 50 SELECT lines.

[skydivetom]

June7 -- I apologize for my delayed response. I just moved the code in a DB and it (successfully) generates the 102 sample records. Thank you for providing such elegant (yet simple) solution.

Please allow me to follow up w/ a clarification question as well w/ a scenario for further enhancing the process.

You indicated the following: "UNION has limit of 50 SELECT lines"
- Does that mean that a string, e.g., 51 words in length (across 50 columns) cannot be processed?
- If so, if I had a single string with more than 50 words -- while all other strings are less or equal to 50 words -- does that mean that a) the entire process would fail OR b) would only that one record be truncated?
- If the entire procedures fails, is there a feasible work-around?

Finally, for demo purposes of this forum post, I extracted the Access table into Excel and then used "text delimitation". I then re-imported the spreadsheet as table [00_tbl_RawData] back into Access.

Now, ideally, I would like to eliminate the need to export/re-import the table from Access to Excel and back into Access. That said, do you know of a simple mechanisn (that could become part of the VBA sub GetWords() which would mimic Excel's text delimitation and thus create the temporary source table [00_tbl_RawData]?

For instance, in the attached DB, I have added the complete original source table [00_OriginalData] which contains the original job title strings.

So, to recap, I'd like to achieve the following:
1. Process table [00_OriginalData] which generates table [00_tbl_RawData]. The field header row could be as simple as "Field1", "Field2", "Field3", ..., ..., "Field50".
2. Then, your existing sub GetWords() is applied sand generates [tblExtract]... which is currently does.

Any thoughts on achieving #1?

Thanks again!!

Tom

[June7]

If there are more than 50 fields, a single UNION sql cannot be constructed because there would be a SELECT line for each field. I would expand the code to include another loop that processes no more than 50 fields at a time and repeats until all fields are read. This will involve a counter variable. Also, the Values field in table should be set to not allow duplicates. Give me few minutes.

There are other ways to read the 50+ fields of data and write to another table - would still involve the looping structure I used. The complication is weeding out duplicate words. UNION query returns only distinct values (UNION ALL would return all, even duplicates).

Really not sure how creating a comma delimited string would be useful.

[skydivetom]

Ok, I think I'm good on the 50 field UNION limitation.

WRT to the other question, there may have been a misunderstanding. Please see attached JPG.

1. My goal is to NOT having to use MS-Excel to transform that job titles (full sentences) into the space-delimited matrix which then requires me to re-import to the table.
2. Currently, this process is required in order to get to table "01_Source_Data_Delimited"... the source for the sub/function you wrote.

So, allow me to rephrase my question...
1. Only using MS-Access, how can I get from the table "00_Source_Data" (top in JPG) to the table "01_Source_Data_Delimited" (bottom in JPG)?
2. Do you know of a function in Access that allows me to transform the original source table (string delimited by space)?

Thanks,
Tom

[June7]

That is certainly not my original understanding of requirement and not the sample data provided in first db. Parsing a string into individual words and saving to a single field is not terribly difficult. One approach uses array object.

Sub GetWords()
Dim db As DAO.Database, rs As DAO.Recordset, ary() As String
Dim x As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT JobTitleDpk FROM 00_Source_Data")
CurrentDb.Execute "DELETE FROM tblExtract"
Do While Not rs.EOF
    ary() = Split(rs("JobTitleDpk"), " ")
    For x = 0 To UBound(ary)
        db.Execute "INSERT INTO tblExtract([Values]) Values('" & ary(x) & "')"
    Next
    rs.MoveNext
Loop
End Sub

Consistent structure of data is critical to string manipulation.

Again, sentence punctuation is retained.

Values is an SQL keyword. Advise to use a different field name.

[skydivetom]

June7 -- thank you for the patience. The modified VBA looks simpler but I'm getting a compile error.

Pls see attached most current DB version. Good call on changing the reserved SQL keyword.

What's causing the compile error? Thanks.

[June7]

Sorry, a little typo when I edited post to add " " to Split() function. Edited.

Also, your strings have apostrophes - that will be an issue with SQL action. Will there be possibility of quote marks?

If you want to prevent duplicate entries, change DistinctWords Indexed property to not allow duplicates.

    Do While Not rs.EOF
        ary() = Split(rs("Skill"), " ")
        For x = 0 To UBound(ary)
            db.Execute "INSERT INTO 01_tbl_DistinctWords([DistinctWord]) Values(""" & ary(x) & """)"
        Next
        rs.MoveNext
    Loop

Alternative to SQL INSERT action is to open a recordset of the empty DistinctWords table and write the values there - apostrophes and quote marks are not an issue. But this approach complicates preventing duplicate entries.

    Dim db As DAO.Database, rs As DAO.Recordset, ary() As String, rsW As DAO.Recordset
    Dim x As Integer
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT Skill FROM 00_tbl_Source_Data")
    CurrentDb.Execute "DELETE FROM 01_tbl_DistinctWords"
    Set rsW = db.OpenRecordset("SELECT * FROM 01_tbl_DistinctWords")
    Do While Not rs.EOF
        ary() = Split(rs("Skill"), " ")
        For x = 0 To UBound(ary)
            rsW.AddNew
            rsW("DistinctWord") = ary(x)
            On Error Resume Next
            rsW.Update
        Next
        rs.MoveNext
    Loop

[orange]

Tom/June

I modified the code in the version03 GetDistinctWords as below- it removes . and , and handles '

Sub GetDistinctWords()
        Dim db As DAO.Database, rs As DAO.Recordset, ary As Variant  'ary() As String
    Dim x As Integer
    Dim I As Integer, j As Integer
    Set db = CurrentDb
    'Set rs = db.OpenRecordset("SELECT JobTitleDpk FROM 00_tbl_Source_Data")
    Set rs = db.OpenRecordset("SELECT Skill FROM 00_tbl_Source_Data")
    
    CurrentDb.Execute "DELETE FROM 01_tbl_DistinctWords"
    
    Do While Not rs.EOF
    '   ary() = Split(rs("JobTitleDpk", " "))
        ary = Split(rs!Skill, " ")
        
        For x = 0 To UBound(ary)
        ary(x) = Replace(ary(x), "'", "''")
        ary(x) = Replace(ary(x), ".", "")
        ary(x) = Replace(ary(x), ",", "")
            db.Execute "INSERT INTO 01_tbl_DistinctWords([DistinctWord]) Values('" & ary(x) & "')"
            I = I + 1
        Next
        
        rs.MoveNext
        j = j + 1
    Loop
       Debug.Print "Finished -processed :" & I & " words  from " & j & "  records"
       Debug.Print "Distinct words : " & DCount("distinctword", "01_tbl_DistinctWords")
End Sub

Hope it's helpful.

[skydivetom]

June7 -- your solution is brilliant.

- Yes, I noticed the issue with the double-quotes. I removed them in the source data (no big deal).
- Changed the index property as suggested. It generated nearly 4,700 distinct keywords within a few seconds... AWESOME!!!

I'll start thinking about next steps for updating my raw data based on this "dictionary"... but that's above and beyond this post. So, again, thank you for assisting me and providing a top-notch solution.

[June7]

I forgot about Replace. Use it and should be able to get by with apostrophes and quotes in data.
No need to replace data in array element.

db.Execute "INSERT INTO 01_tbl_DistinctWords([DistinctWord]) Values('" & Replace(Replace(Replace(ary(x), ",", ""), ".", ""), "'", "''") & "')"