Make a record set loop through a query for each Unique Record in my "SRO Number" field.

Question

My ultimate goal here is to export files from Access to Excel.  I have 1 big table, and I want a new Excel file for each value in the "MMO Number" field of the table.  I can get everything to work, except it makes 1 big file with the entire table on it.

I need help creating the code that runs the process every time the "MMO Number" value is different.

The loop function is already installed...

Here is the part of my code that defines which query to output:

_______________________________________________________________

   Set rs = db.OpenRecordset("Q_FINAL MMO LETTER")

   rs.MoveFirst

  ' loop through each record in the first recordset

  Do Until rs.EOF

Somewhere in here, I need to identify each distinct record in the "MMO Number" field I think...

Any help would be EXTREMELY APPRECIATED!

THanks,

Billy

Answer 1

Billy

Presently, you are only creating one worksheet. I'm not much of an Excel automation guy so I'm not certain of what you need to do, but if you want a separate sheet for each SRO Control #, you will have to do it within the loop, not outside of it.

And this line:

ws.Range("A1").CopyFromRecordset

is reading the entire recordset into the sheet. YOu only want to read one line at a time so you can check the SRO Control #. Therefore, you have to limit the recordset to one SRO Control #.

Here  is a samplpe using Northwind. I purposely used TOP 10 just to limit the test. You would want to get all the SRO Controls so don't use that.

Public Sub FillWrksht()

    Dim db As Database

    Dim rs As Recordset

    Dim rsCustomerIDs As Recordset

    Dim objExcel As New Excel.Application

    Dim wb As Workbook

    Dim ws As Worksheet

    Dim strSRONumber As String

    Dim x As Integer

    Set db = CurrentDb

    Set rsCustomerIDs = db.OpenRecordset("SELECT DISTINCT TOP 10 CustomerID FROM Orders ORDER BY CustomerID")

    Set wb = objExcel.Workbooks.Add("C:\Temp_C\Test.xltx")

    Set ws = wb.Worksheets("Data")

    ws.Activate

    With rsCustomerIDs

        .MoveFirst

        strSRONumber = !CustomerID

        Do Until .EOF

            If strSRONumber <> !CustomerID Then GoTo LoopMe

            Set rs = db.OpenRecordset("SELECT CustomerID, OrderID, OrderDate " _

                    & "FROM Orders WHERE CustomerID = '" & rsCustomerIDs!CustomerID & "'")

            ws.Range("A1").CopyFromRecordset rs

LoopMe:

            .MoveNext

            If Not .EOF Then

                'Increment counter for sheet name

                x = x + 1

                'Add a new worksheet

                Set ws = wb.Worksheets.Add

                ws.name = "Data" & x

                ws.Activate

                strSRONumber = !CustomerID

            End If

        Loop

    End With

    Set rs = Nothing

    Set rsCustomerIDs = Nothing

    Set db = Nothing

    Set ws = Nothing

    wb.SaveAs "C:\Temp_C\Test_" & Format(Now(), "yyyymmddhhnnss") & ".xlsx"

    wb.Close

    Set wb = Nothing

    objExcel.Quit

    Set objExcel = Nothing

End Sub

---

Bill Mosca www.ThatllDoIT.com

Answer 2

Hello Bill,

It still does not seem to be working.  It is creating one spreadsheet with all the data in "Q_FINAL SRO LETTER" instead of seperate spreadsheets for each "SRO Control #"...

Any Ideas?  I am completely clueless on this one :(

Thank you for your help!!!

Answer 3

Bill

My mistake! I left out one line:

        If strSRONumber <> rs("SRO Control #") Then

        strSRONumber = rs("SRO Control #")        Ws.Range("A1").CopyFromRecordset rs

Sorry, but airware is untestable. <s>

---

Bill Mosca www.ThatllDoIT.com

Answer 4

Hi Bill,

That did not seem to work, but I assume my code may be off somewhere else.  Would you mind taking a look?  I haveboldedthe pieces you gave me from before.  THANK YOU!

    'Declare variables

    Dim db As Database

    Dim rs As Recordset

    Dim Ws As Object 'Generic object that you can assign anything to it

    Dim i As Long

    Dim Path As String

    Dim wb As Workbook

    Dim wrkSheet As Worksheet

    Dim name As String

    Dim iRowCopy As Long

    Dim dlrName As String

    Dim rng As Range

    Dim cell As Range

    Dim k As Long

    Dim total As Long

    Dim display_value As String

    Dim Strsql As String

    Dim strSRONumber As String

     'Create a new workbook for each dealer and add this template to it.

    Set wb = Workbooks.Add("U:\Warranty\SRO\SRO Letters\SRO_Template.xls")

    'MsgBox ("Please Delete all the Dealer reports from C:\Tasks\WIP\SWR1200_MDIReport\new_scripts\MDI Global Reports\Dealer Reports ")

   'Set the worksheet object to our "Data" sheet in our template file

    Set wrkSheet = wb.Sheets("Data")

   'This could be removed and you could just use the wrkSheet object instead

   'of the generic Ws object

    Set Ws = wrkSheet

   'Set the Path to the database

   'julie changed to reflect new server

   ' Path = "U:\Warranty\SRO\SRO Letters"

   Set db = CurrentDb

   'Set the Database, and RecordSet

   'Set Db = Workspaces(0).OpenDatabase(path, ReadOnly:=True)

   'This will set the RecordSet to all records in the Q_FINAL SRO LETTER Query

   'Set Rs = Db.OpenRecordset("Q_FINAL SRO LETTER")

   Set rs = db.OpenRecordset("Q_FINAL SRO LETTER")

   rs.MoveFirst

  ' loop through each record in the first recordset  'Get first MMO Number    strSRONumber = rs("SRO Control #")    Do While Not rs.EOF        If strSRONumber <> rs("SRO Control #") Then

        Ws.Range("A1").CopyFromRecordset rs

        'This next code set will just select the data region and

        'auto-fit the columns

        'Ws.Range("A1").Select

        'Selection.CurrentRegion.Select

        'Selection.Columns.AutoFit

        Set rng = Ws.Range("A1").CurrentRegion

        For Each cell In rng

            'If cell.Value <> "" Then

            '    cell.NumberFormat = "General"

            '    cell.Value = cell.Value

            'End If

            If IsEmpty(cell.Value) Then

                cell.NumberFormat = "General"

                cell.Value = "N/A"

            Else

                If cell.Value <> "" Then

                   cell.NumberFormat = "General"

                   cell.Value = cell.Value

               End If

            End If

        Next

        'Ws.Range("A1").Select

        'Hide the "Data" sheet in each dealers .xls file only show graphs

        Ws.Visible = False

        'Save each workbook as the name of each dealer

        '[Forms]![pac_excel_generate]!display = Worksheets(1).Range("A1").Value

        wb.SaveAs "U:\Warranty\SRO\SRO Letters\SRO LETTER FOLDER\SRO Letter" & " " & Worksheets(1).Range("Q1") & Worksheets(1).Range("AA1") & Worksheets(1).Range("D1").Value

        wb.Close

        'Move to the next dealer and repeat the process for the next dealer

      '  Rs.MoveNext

        Set wb = Workbooks.Add("U:\Warranty\SRO\SRO Letters\SRO_Template.xls")

        Set wrkSheet = wb.Sheets("Data")

        Set Ws = wrkSheet

        Ws.Activate

        rs.MoveNext

    rs.Close

   db.Close

   DoCmd.Hourglass False

Else: GoTo LoopMe        End IfLoopMe:    Loop

   MsgBox ("SRO Letters Generated Please Have A Fantabulous Day!")

End Sub

Answer 5

It sounds like all you need is a variable to hold the number and then compare it to the next one.

    Dim strMMONumber As String

    'Get first MMO Number

    strMMONumber = rs("MMO Number")

    Do While Not rs.EOF

        If strMMONumber <> rs("MMO Number") Then

            'do stuff

        Else: GoTo LoopMe

        End If

LoopMe:

    Loop

---

Bill Mosca www.ThatllDoIT.com