Using 2 unrelated tables in a routine 1

[Delindan]

I'm am fairly new to vba and would like to write a routine that would have a main routine that makes a class list from a student table on an excel sheet, and then a sub routine that would list out the pta reps under each class from a second table. Since I am new to sub routines here are my questions:

at the end of the teacher list I would reference that pta sub and then return to the student database that would then move to the next teacher and so on. The pta reps are in an unrelated table from students although teacher name is a commen thread. Once the sub routine is done and I return to the main routine, will it know which table it is in and be at the correct place in the table?

Does this logically sound like it would work or does anyone have a better logical process? thx!

 

[SkipVought]

Hi,

How are you getting your data into Excel?

I would suggest that you get out of VBA and in a blank sheet, query the tables that you need, via Data > Import External Data.

Please list your tables and fields clearly.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Delindan]

Sorry...apparently I'm not very good explaining my thought process. I have 2 tables the collectively will be used to make up multiple excel spreadsheets...

This is what I have so far which doesn't include the pta information that will be at the bottom of each teachers info...I will insert a comment on where I believe I should be inserting a call to a subroutine that would use the pta table and list the rep(s) at the bottom of each teachers classroom list:

Option Compare Database

Sub cmdCreateForm_Click()

Dim DB As Database
Dim xlApp As New excel.Application
Dim WB As Workbook
Dim WS As excel.Worksheet
Dim RSPtarep As Recordset
Dim RSStudents As Recordset
Dim strFileName As String
Dim strFolder As String
Dim strTeacher As String
Dim strGrade As String
Dim introw As Long
Dim Intcol As Long

strFolder = Trim(txtfolder)
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If

Set DB = CurrentDb
'Set RSPtarep = DB.OpenRecordset("PTA Reps", dbOpenSnapshot)
Set RSStudents = DB.OpenRecordset("Excel Sort", dbOpenSnapshot)


RSStudents.MoveFirst
Do Until RSStudents.EOF
Intcol = 0
introw = 0
strGrade = RSStudents("Grade")
strFileName = strFolder & strGrade & ".xlsx"
txtCurrProfile = "Creating " & strGrade & ".xlsx..."
DoEvents

With xlApp
.Visible = False
Set WB = .Workbooks.Add

End With
'xlApp.Worksheets(1).CenterHeader = "&""Palatino Linotype,Bold Italic""&18Grade " & strGrade
Do While strGrade = RSStudents("Grade")
strTeacher = RSStudents("Teacher")
introw = introw + 1
Intcol = Intcol + 1
xlApp.Worksheets(1).Cells(introw, Intcol) = RSStudents("Teacher")
introw = introw + 2
xlApp.Worksheets(1).Cells(introw, Intcol) = "Rm: " & RSStudents("Extension")
introw = introw + 3
Do While strTeacher = RSStudents("Teacher")
xlApp.Worksheets(1).Cells(introw, Intcol) = RSStudents("First") & " " & RSStudents("Last")
introw = introw + 1
RSStudents.MoveNext
If RSStudents.EOF Then Exit Do
Loop
introw = 0
If RSStudents.EOF Then Exit Do
Loop
'this is where I believe I should call the subroutine
With xlApp
.Workbooks(1).SaveAs (strFileName)
.Workbooks(1).Close
End With

Loop

xlApp.Quit
RSStudents.Close
DB.Close

Set xlApp = Nothing
Set RSStudents = Nothing
Set DB = Nothing

txtCurrProfile = "Done!"
DoEvents

End Sub


My question is if this sounds like appropriate/correct way to attack the task?

Thanks!

 

[kjv1611]

I have a serious question here. Why aren't you simply using queries to do all of this, and then use VBA only to export the data to Excel, if that's your desired output?

You say they are unrelated, but they are related to some extent. The Students are related to a class... and it sounds like the pta folks are also related to a certain class... or is that piece more or less random, I didn't read really deaply into this one so far.

Now, if the classes can change, as far as adding/deleting classes, then it may be best to do like this:
1. Create a query to get the results you want for one class.
2. Once you have that working, copy the SQL from the query to VBA, and you'll use it to build custom SQL strings.
3. Keep a table of classes - which can then be updated as necessary.
4. Have the query modified each time you run it to where it builds the results for each query.
6. Build another query or queryset that does the same thing for pta.

7. Now, how you get it to Excel will depend. If you can make the columns match up in everything but Title, then you might could then use UNION queries to join the 2 different query results - so UNION the class students and the class pta reps.

8. If that is not possible, then you could export each query for the class of students... and then use VBA to basically paste the pta reps at the bottom of each sheet...

Hopefully I'm not off in left field. If I get more time later, I'll read over this more carefully. But I'm not promising I will.

 

[Delindan]

The reason I'm not just exporting a query is because of how I want the spreadsheet to organized. I haven't tried a union query before. I will look at that to see if it fits the need to get both the tables info. Thanks

 

[Delindan]

So I tried it and actually got a result...not the one I wanted. The main routine lists the teacher and students under then a sub routine switches to the pta table and lists the reps then back to the main for the next teacher. It creates a new file for each grade level. What happens is it works for the first teacher (yeah) but then for the remainder of the teachers doesn't list any pta reps. One interesting thing to note is that the first teacher has students in 1, 2 and 3 and it correctly lists the reps in each grade file under her class even though there are other teachers on each sheet that correctly list all their students. This is my first attempt at a sub routine so I'm guessing I am missing something obvious here. Any ideas? Here's my code:

Option Compare Database

Sub cmdCreateReport_Click()

Dim DB As Database
Dim xlApp As New Excel.Application
Dim WB As Workbook
Dim WS As Excel.Worksheet
Dim RSStudents As Recordset
Dim blnSheetDone As Boolean
Dim strFileName As String
Dim strFolder As String
Dim strTeacher As String
Dim strGrade As String
Dim introw As Long
Dim intcol As Long

strFolder = Trim(txtfolder)
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If

Set DB = CurrentDb
Set RSStudents = DB.OpenRecordset("Excel Sort", dbOpenSnapshot)


RSStudents.MoveFirst
Do Until RSStudents.EOF
intcol = 0
introw = 0
strGrade = RSStudents("Grade")
strFileName = strFolder & strGrade & ".xlsx"
txtCurrProfile = "Creating " & strGrade & ".xlsx..."
DoEvents

With xlApp
.Visible = False
Set WB = .Workbooks.Add
End With

Do While strGrade = RSStudents("Grade")
strTeacher = RSStudents("Teacher")
introw = introw + 1
intcol = intcol + 1
xlApp.Worksheets(1).Cells(introw, intcol) = RSStudents("Teacher")
With xlApp
.Cells(introw, intcol).Font.Name = "Palatino Linotype"
.Cells(introw, intcol).Font.Size = 11
.Cells(introw, intcol).Font.Bold = True
End With
introw = introw + 2
xlApp.Worksheets(1).Cells(introw, intcol) = "Rm: " & RSStudents("Extension")
introw = introw + 3
Do While strTeacher = RSStudents("Teacher")
xlApp.Worksheets(1).Cells(introw, intcol) = RSStudents("First") & " " & RSStudents("Last")
introw = introw + 1
RSStudents.MoveNext
If RSStudents.EOF Then Exit Do
Loop
introw = introw + 2
blnSheetDone = Profile_Sheet(strTeacher, introw, intcol, WB, xlApp)
introw = 0
If RSStudents.EOF Then Exit Do
Loop
With xlApp
.Workbooks(1).SaveAs (strFileName)
.Workbooks(1).Close
End With

Loop

xlApp.Quit
RSStudents.Close
DB.Close

Set xlApp = Nothing
Set RSStudents = Nothing
Set DB = Nothing

txtCurrProfile = "Done!"
DoEvents

End Sub



Private Function Profile_Sheet(strTeacher As String, introw As Long, intcol As Long, WB As Workbook, xlApp As Excel.Application) As Boolean

Dim DB As Database
Dim RSPtareps As Recordset

Profile_Sheet = False

Set DB = CurrentDb

Set RSPtareps = DB.OpenRecordset("PTA Reps Query", dbOpenSnapshot)

RSPtareps.FindFirst ("Teacher" = strTeacher)
Do While RSPtareps("Teacher") = strTeacher
xlApp.Worksheets(1).Cells(introw, intcol) = RSPtareps("Name")
introw = introw + 1
xlApp.Worksheets(1).Cells(introw, intcol) = RSPtareps("Phone number")
introw = introw + 1
xlApp.Worksheets(1).Cells(introw, intcol) = RSPtareps("E-Mail")
introw = introw + 1
RSPtareps.MoveNext
Loop

Profile_Sheet = True

End Function

 

[PHV]

I'd replace this:
[tt]RSPtareps.FindFirst ("Teacher" = strTeacher)[/tt]
with this:
[tt]RSPtareps.FindFirst ("Teacher='" & strTeacher & "'")[/tt]

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Delindan]

thanks! I tried this and it stopped at a weird place. Started with 1 (grade 1) and listed all the teachers with their students and pta reps, saved and closed. Created 2 (grade 2) and listed all the teachers with their students and pta reps below and errored out at the Do While RSPtareps("Teacher") = strTeacher line. The grade 2 file was completed but not saved or closed. The error was 3021...no current record. Why would it err out at the end of grade 2 but not at the end of grade 1? Any ideas?

 

[kjv1611]

Any reason you can't do it this way?

Do While Not RSPtareps.EOF

  If RSPtareps("Teacher") = strTeacher
    xlApp.Worksheets(1).Cells(introw, intcol) = RSPtareps("Name")
    introw = introw + 1
    xlApp.Worksheets(1).Cells(introw, intcol) = RSPtareps("Phone number")
    introw = introw + 1
    xlApp.Worksheets(1).Cells(introw, intcol) = RSPtareps("E-Mail")
    introw = introw + 1
  End If

  RSPtareps.MoveNext
Loop

 

[kjv1611]

Or actually... better yet.... Why not create a filtered recordset by putting your criteria into a query... then build the recordset off of that? That should be more efficient anyway...

 

[Delindan]

Can you create a temporary filter on the pta file that can be updated for a new teacher each time? How would you do that?

Thanks!

 

[Delindan]

tried it your way and it worked just fine...thanks so much!