Excel Export w/ Wkshts based on Mnth and Yr

J

jskillz25

Hello all.

I'm brand new to this forum, so I hope I'm posting this in the right section.

I've established code that will export data to excel into a workbook with
tabs(worksheets) for each month(based on a field expdate). What I'd like to
do is make tabs not only based on month, but on year as well, for the
following reason:

Basically, each group of customers is generally in a 12 month time-frame;
however, there are some exceptions to the rule that extend into the previous
year and the upcoming year. So, my ideal set-up would be to probably create
worksheets with outer limits that only extend to months that contain records.
So, if there was a policy that had an exp date of 12/24/05 and the rest were
in '06, the output would only create a dec 2005 and not a nov2005 or any
other 2005 because they didn't contain records. Hope this kind of helps w the
explanation.

Here is the code I've been working with (I didn't set it all up, much is
taken from online examples, but the field names are mine and part of my test
database)

Sub CreateXL()
Dim strSQL As String
Dim qdf As Object
Dim strFilename As String
Dim I As Long
Dim Yr As Long
Dim YearFirst As Long
Dim YearLast As Long
Dim resp

strFilename = "C:\" & [Forms]![Form]![TC] & ".xls"

If Dir(strFilename) <> "" Then
resp = MsgBox("This group's import already exists." & vbCrLf & "Do
you wish to replace it?", vbYesNo)
If resp = vbYes Then
Kill strFilename
Else
Exit Sub
End If
End If

YearFirst = DMin("Year(ExpDate)", "Table1")
YearLast = DMax("Year(ExpDate)", "Table1")
For Yr = YearFirst To YearLast
If DCount("Year(Expdate)", "Table1", "Year(Expdate)=" & Yr) > 0 Then

For I = 1 To 12
If DCount("Month(Expdate)", "Table1", "Month(Expdate)=" & I)
strSQL = "SELECT Table1.Customer, Table1.ZipCode, Table1.
ItemType, Table1.ExpDate "
strSQL = strSQL & "FROM Table2 INNER JOIN Table1 ON
Table2.GroupCode = Table1.GroupCode "
strSQL = strSQL & "WHERE Table1.GroupCode='" & [Forms]!
[Form]![TC] & "' AND Month(Table1.Expdate)= " & I & " AND Year(Table1.Expdate)
= " & Yr
strSQL = strSQL & " ORDER BY Table1.Customer"
Set qdf = CurrentDb.CreateQueryDef(Format(DateSerial(2006,
I, 1), "mmm") & Yr, strSQL)
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, qdf.Name, strFilename
CurrentDb.QueryDefs.Delete qdf.Name
End If
Next I

End If
Next Yr
FormatWB strFilename
End Sub
Sub FormatWB(strFilename As String)
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Open(strFilename)
For Each xlWS In xlWB.Worksheets
xlWS.Range("A1:L1").Font.Bold = True
xlWS.Range("A:L").Columns.AutoFit
xlWS.Range("1:1").Insert
With xlWS.Range("A1")
.Value = [Forms]![Form]![TC]
.Font.Size = 24
.Font.Bold = True
End With
Next xlWS
xlWB.Close True
DoCmd.Close ' Close Form
End Sub



Thanks for any help! Right now I can't really tell what range of months my
code is taking, but my goal was to only have wksht tabs that extend to the
outter limits of the exp date field.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top