[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

vba code to manipulate values from a query and output results to a table

Posted on 2011-05-12
8
Medium Priority
?
421 Views
Last Modified: 2013-11-27
I have a query called "zzzzdups" that outputs results of three columns as shown below.  What I need help with is if there are duplicate IITReportNo, as shown below, I want to take the associated ReceiverNo and combine them into one record and dump into a table called "zzzzdupsfinal" where the record would look like as shown below.  The ReceiverNo values should be combined with a comma and a space.  Could really use expert help here please.  Thank.

"zzzdups" query output:
IITReportNo      IITDate      ReceiverNo
20332                      1/4/2010      R30265
20332                      1/4/2010      R30246
20332                      1/4/2010      R30234
20332                      1/4/2010      R30202
20332                      1/4/2010      R30172

"zzzdupsfinal" table output"
IITReportNo      IITDate      ReceiverNo
20332                      1/4/2010      R30265, R30234, R30202, R30172
0
Comment
Question by:sxxgupta
8 Comments
 
LVL 40

Expert Comment

by:als315
ID: 35745533
0
 
LVL 120

Accepted Solution

by:
Rey Obrero (Capricorn1) earned 1000 total points
ID: 35745803
0
 

Author Comment

by:sxxgupta
ID: 35745919
Ok, and how would I incorporate the Dconcat function into the sql statement below.........................
If arr(i) Like "[R][0-9]*" Then
            strInsert = UCase(arr(i))
            If Len(strInsert) = 6 Then
            CurrentDb.Execute "INSERT INTO ReceiverNoTable(IITReportNo,IITDate,ReceiverNo) " & _
            "VALUES(" & rst("IITReportNo") & ", #" & Format(rst("IITDate"), "mm/dd/yyyy") & "#, '" & strInsert & "')"
            End If
End If

Open in new window

0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 40

Assisted Solution

by:als315
als315 earned 1000 total points
ID: 35746212
Look sample based on DConcat.mdb example from article (zzzdups - table with yor data, zzzdups_Dconcat - query with result)
DConcat.mdb
0
 

Author Comment

by:sxxgupta
ID: 35746971
Yes I got that.  However, with my coding right now, I do a de-concatenate, and then a re-concatanate...............and need help with that.  So during the "INSERT....." part of the sql statement, I want to be able to perform the concatenation all in one subroutine....................
Sub CleanData1()
  
Dim arr() As String
Dim strDefects As String, strInsert As String
Dim strDefects1 As String, strInsert1 As String
Dim strDefects2 As String, strInsert2 As String
Dim rst As DAO.Recordset
Dim i As Integer
Dim Count As Integer
 
On Error GoTo ProcError

DoCmd.SetWarnings False
DoCmd.OpenQuery "ziitdataqry"
DoCmd.RunSQL "DELETE * FROM ReceiverNoTable"
DoCmd.SetWarnings True

Count = 1
Set rst = CurrentDb.OpenRecordset("SELECT * FROM [ReceiverNoMakeTable]" & _
"WHERE IITDate BETWEEN #" & Forms![z filter].[BeginDate] & "# AND #" & Forms![z filter].[EndDate] & "# " & _
"ORDER BY IITReportNo")
 
While Not rst.EOF
    
    strDefects = Nz(rst("Comments"), "")
    strDefects = Replace(strDefects, ",", " ")
    strDefects = Replace(strDefects, vbCrLf, " ")
    strDefects = Replace(strDefects, "&", " ")
    strDefects = Replace(strDefects, "/", " ")
    strDefects = Replace(strDefects, "]", "")
    strDefects = Replace(strDefects, "`", "")
    strDefects = Replace(strDefects, "-", "")
    strDefects = Replace(strDefects, ".", "")
    strDefects = Replace(strDefects, "#", "")
    'you may need a couple of others for strange characters that have been used'
  
    'Strip leading spaces'
    strDefects = Trim(strDefects)
  
    'replace multiple space characters with a single one'
    Do While InStr(strDefects, "  ") > 0
        strDefects = Replace(strDefects, "  ", " ")
    Loop
    arr = Split(strDefects, " ")
    For i = LBound(arr) To UBound(arr)
        'accounts for 3rd, 4th, ... numbers that do not include leading values'
        If i = 0 And Len(arr(i)) = 1 Then Exit For
            'i = i + 1
        'End If
        If arr(i) Like "[R][0-9]*" Then
            strInsert = UCase(arr(i))
            If Len(strInsert) = 6 Then
            CurrentDb.Execute "INSERT INTO ReceiverNoTable(IITReportNo,IITDate,ReceiverNo) " & _
            "VALUES(" & rst("IITReportNo") & ", #" & Format(rst("IITDate"), "mm/dd/yyyy") & "#, '" & strInsert & "')"
            End If

        End If

    Next i
    rst.MoveNext
Wend

  
ProcExit:
    If Not rst Is Nothing Then
        rst.Close
        Set rst = Nothing
        MsgBox "Done."
    End If
    Exit Sub
 
ProcError:
    'Select Case err.Number
        'Case 9999, 10000, 11000, 12000, 13000
            'Debug.Print "Count: " & Count & "   " & err.Description & "    " & "IITReportNo:" & rst("IITReportNo") & "  ReceiverNo: " & strDefects
        'Case Else
            'Debug.Print err.Number, err.Description, strInsert, "IITReportNo:" & rst("IITReportNo") & ""
    'End Select
    Resume Next
     
End Sub

Open in new window

0
 
LVL 40

Expert Comment

by:als315
ID: 35747118
May be you need to change your code to:
 
strInsert=""
For i = LBound(arr) To UBound(arr)
        'accounts for 3rd, 4th, ... numbers that do not include leading values'
        If i = 0 And Len(arr(i)) = 1 Then Exit For
            'i = i + 1
        'End If
        If arr(i) Like "[R][0-9]*" Then
            If Len(arr(i)) = 6 Then
                if len(strInsert) > 0 then strInsert = strInsert & ", "
                strInsert = strInsert & UCase(arr(i))
            End If
        End If
Next i
CurrentDb.Execute "INSERT INTO ReceiverNoTable(IITReportNo,IITDate,ReceiverNo) " & _
"VALUES(" & rst("IITReportNo") & ", #" & Format(rst("IITDate"), "mm/dd/yyyy") & "#, '" & strInsert & "')"

Open in new window

0
 
LVL 26

Expert Comment

by:Nick67
ID: 35751031
How many records are you talking about processing?

This can be done in about 30-40 lines of VBA walking once down a recordset
'pseudocode
open a recordset that finds the duplicates (firstRS)
do until firstRS.eof
     open a recordset that has the records where the PK that matches the current record in the first set
            do until secondRS.eof
                    TheConcat = TheConcat & secondRS!ReceiverNo & ","
            loop
            'get rid of the last comma
            TheConcat = left(TheConcat,Len(theConcat)-1)
            open a third recordset to add the first two fields and TheConcat
            close the second recordset
loop

Hundreds of thousands of lines aren't efficient, but for <10000 this kicks ass, and is debuggable

   
0
 

Author Closing Comment

by:sxxgupta
ID: 35751053
I am splitting the points between both experts b/c I NEED both versions.  Thanks everyone!!!
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
If you’re using QODBC to update QuickBooks data from Microsoft® Access but Access is not showing the updated data, you could have set up QODBC incorrectly.
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
Suggested Courses

829 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question