Updating Excel - On 3rd Loop Only, Access Code Will Not Unselect Two Excel Worksheets

[orcinus]

edit: using windows 7, access 2010

I have some Access code that when run, creates an Excel sheet (ultimately with 3 wksheets). After each wksheet is created the code calls another sub that formats whatever wksheet has just been created via that excel spreadsheet. Once formatting is complete, control passes back to the calling code and the next wksheet is created, the excel formatting code is called again and so forth until all 3 wksheets have been created..(there is other code that loops to creates other spreadsheets with different districts but doing the basic process)..

Upon the first 2 loops - there are no issues. The first and 2nd worksheet wksheet is created and formatting is applied.

However, upon the 3rd loop and creation of the 3rd wksheet, for some reason, when the spreadsheet is re-opened for formatting, it is opened with both the 2nd and 3rd wksheets selected (the code does ask for the 3rd wksheet to receive the primary focus which it does). This is also true for the 2nd loop, 2nd wksheet creation..but..keep reading!

Previously, in the last loop that created the 2nd wksheet, this was also true (except that the 1st and 2nd wksheet were selected, the focus being on the 2nd), however, upon hitting the code in the formatting section per the line: .Activate, both wksheets were unselected, leaving the focus on the 2nd wksheet and so formatting proceeded as planned with no issues..

However, in the 3rd loop, for whatever reason(s) when the spreadsheet is opened with both the 2nd/3rd wksheets selected, when the .Activate line is reached, unlike with the 2nd loop, both wksheets remain selected!!! (the 3rd still has the focus, but this creates problems for the imminent formatting)

So, wondering why the code will not unselect both wksheets per the 3rd run at the .Activate line as it did for the 2nd loop?

This creates two problems. One is that for the 3rd loop, all formatting done on that 3rd wksheet will now apply to the 2nd wksheet - not desirable! 2nd, it bombs when it gets to the last piece where the remove filter code is (Xl.Selection.AutoFilter) because when two or more wksheets are selected, filtering is turned off (shows greyed out). And so I get an error.

Here is the code - both spreadsheet creation (sub_excel_export) and excel formatting that the main code calls (sub_format_excel):

Thanks for any help!

Sub sub_excel_export()

Dim qdfs As dao.QueryDefs
Dim qdf As dao.QueryDef
Dim db As dao.Database
Dim str_qry_name As String
Dim int_nbr_districts As Integer
Dim str_sql_1 As String
Dim str_sql_2 As String
Dim rs1 As dao.Recordset
Dim str_district_code As String
Dim str_district_name_trunc As String
Dim str_qry_exp As String

Dim str_abs_cat_pos(3) As String
Dim str_abs_cat_rate(3) As String
Dim str_abs_cat_site_add_per(3) As String

Dim i As Integer

str_abs_cat_pos(1) = "pos_truant"
str_abs_cat_pos(2) = "pos_eea"
str_abs_cat_pos(3) = "pos_chronic"

str_abs_cat_rate(1) = "truant_rate"
str_abs_cat_rate(2) = "eea_rate"
str_abs_cat_rate(3) = "chronic_rate"

str_abs_cat_site_add_per(1) = "site_name_recoded_add_rate_truant"
str_abs_cat_site_add_per(2) = "site_name_recoded_add_rate_eea"
str_abs_cat_site_add_per(3) = "site_name_recoded_add_rate_chronic"



Dim str_fp As String
Dim str_fn As String
Dim str_fqfp As String

str_fp = "U:\UA_Processing\Heat Maps\"


Set db = CurrentDb

str_sql_1 = "select districtCode, district_name_trunc from tbl_heat_map group by districtCode, district_name_trunc"

Set rs1 = db.OpenRecordset(str_sql_1, dbOpenDynaset)
rs1.MoveFirst

str_district_code = rs1!districtCode
str_district_name_trunc = rs1!district_name_trunc
str_fn = "Heat Map - " & str_district_name_trunc
str_fqfp = str_fp & str_fn


Do Until rs1.EOF = True


For i = 1 To 3

str_qry_name = "qry_output_" & Mid(str_abs_cat_pos(i), 5)

Set qdf = db.CreateQueryDef(str_qry_name)

str_sql_2 = "select " & str_abs_cat_pos(i) & ", " & str_abs_cat_site_add_per(i) & ", site_type, " & str_abs_cat_rate(i) & " from tbl_heat_map" _
& " where districtCode = '" & str_district_code & "' order by " & str_abs_cat_rate(i) & " desc, site_name_recoded, " & str_abs_cat_pos(i)

qdf.SQL = str_sql_2


DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, str_qry_name, str_fqfp, -1

DoCmd.DeleteObject acQuery, str_qry_name

Call sub_format_excel(str_fqfp & ".xlsx", i)

Next


rs1.MoveNext

If rs1.EOF = True Then
MsgBox "Completed Spreadsheet Heat Map Creation"
Else
str_district_code = rs1!districtCode
str_district_name_trunc = rs1!district_name_trunc
str_fn = "Heat Map - " & str_district_name_trunc
str_fqfp = str_fp & str_fn
End If

Loop


End Sub

Sub sub_format_excel(str_file_name As String, int_wksheet As Integer)

Dim MySheetPath As String
Dim Xl As Excel.Application
Dim XlBook As Excel.Workbook
Dim XlSheet As Excel.Worksheet

Set Xl = New Excel.Application
Xl.Visible = True

Set XlBook = Xl.Workbooks.Open(str_file_name)
Set XlSheet = XlBook.Worksheets(int_wksheet)

With XlSheet
.Activate 'does not unselect 2nd/3rd wksheet per 3rd loop - however this line **does** unselect 1st/2nd wksheet after 2nd loop and creation of 2nd tab!
.Range("A1").Select
.Range(Xl.Selection, Xl.Selection.End(xlToRight)).Select
.Range(Xl.Selection, Xl.Selection.End(xlDown)).Select


Xl.ActiveSheet.Range("B1").AutoFilter Field:=3, Criteria1:="E"
.Range("B1").Select
.Range(Xl.Selection, Xl.Selection.End(xlDown)).Select
With Xl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15458751
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Xl.ActiveSheet.Range("$B$1").AutoFilter Field:=3, Criteria1:="H"
.Range(Xl.Selection, Xl.Selection.End(xlDown)).Select
With Xl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 7495972
.TintAndShade = 0
.PatternTintAndShade = 0
End With


Xl.ActiveSheet.Range("$B$1").AutoFilter Field:=3, Criteria1:="M"
.Range("B1").Select
.Range(Xl.Selection, Xl.Selection.End(xlDown)).Select
With Xl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 11178551
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Xl.ActiveSheet.Range("$B$1").AutoFilter Field:=3
.Range("B1").Select
With Xl.Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Range("A1").Select

'FAILS HERE!!!

Xl.Selection.AutoFilter '- fails at this line per the 3rd loop - due to 2nd/3rd worksheets still selected..!
Xl.ActiveCell.Columns("A:E").EntireColumn.EntireCo lumn.AutoFit
Xl.ActiveCell.Select

Xl.Range("A1").Select

End With

XlBook.Save
XlBook.Close

Set Xl = Nothing
Set XlBook = Nothing
Set XlSheet = Nothing


End Sub

[rpeare]

Can you supply a sample database so I don't have to recreate these objects to test your code? Just make a new database and import the relevant object and populate it with junk, just enough to simulate the problem then zip it up and upload it using the GO ADVANCED button in the lower right corner of the posting area.

[orcinus]

Can you supply a sample database so I don't have to recreate these objects to test your code? Just make a new database and import the relevant object and populate it with junk, just enough to simulate the problem then zip it up and upload it using the GO ADVANCED button in the lower right corner of the posting area.

Sorry for taking so long to respond, but I found a solution to this issue. Apparently, from Access, all the 'Selection' syntax isn't needed. Here is the solution:

Sub sub_excel_export()

Dim qdfs As dao.QueryDefs
Dim qdf As dao.QueryDef
Dim db As dao.Database
Dim str_qry_name As String
Dim int_nbr_districts As Integer
Dim str_sql_1 As String
Dim str_sql_2 As String
Dim rs1 As dao.Recordset
Dim str_district_code As String
Dim str_district_name_trunc As String
Dim str_qry_exp As String

Dim str_abs_cat_pos(3) As String
Dim str_abs_cat_rate(3) As String
Dim str_abs_cat_site_add_per(3) As String

Dim i As Integer

str_abs_cat_pos(1) = "pos_truant"
str_abs_cat_pos(2) = "pos_eea"
str_abs_cat_pos(3) = "pos_chronic"

str_abs_cat_rate(1) = "truant_rate"
str_abs_cat_rate(2) = "eea_rate"
str_abs_cat_rate(3) = "chronic_rate"

str_abs_cat_site_add_per(1) = "site_name_recoded_add_rate_truant"
str_abs_cat_site_add_per(2) = "site_name_recoded_add_rate_eea"
str_abs_cat_site_add_per(3) = "site_name_recoded_add_rate_chronic"


Dim str_fp As String
Dim str_fn As String
Dim str_fqfp As String

str_fp = "U:\UA_Processing\Heat Maps\"


Set db = CurrentDb

str_sql_1 = "select districtCode, district_name_trunc from tbl_heat_map group by districtCode, district_name_trunc"

Set rs1 = db.OpenRecordset(str_sql_1, dbOpenDynaset)
rs1.MoveFirst

str_district_code = rs1!districtCode
str_district_name_trunc = rs1!district_name_trunc
str_fn = "Heat Map - " & str_district_name_trunc
str_fqfp = str_fp & str_fn


Do Until rs1.EOF = True


For i = 1 To 3

str_qry_name = "qry_output_" & Mid(str_abs_cat_pos(i), 5)

Set qdf = db.CreateQueryDef(str_qry_name)

str_sql_2 = "select " & str_abs_cat_pos(i) & ", " & str_abs_cat_site_add_per(i) & ", site_type, " & str_abs_cat_rate(i) & " from tbl_heat_map" _
& " where districtCode = '" & str_district_code & "' order by " & str_abs_cat_rate(i) & " desc, site_name_recoded, " & str_abs_cat_pos(i)

qdf.SQL = str_sql_2


DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, str_qry_name, str_fqfp, -1

DoCmd.DeleteObject acQuery, str_qry_name



Next


rs1.MoveNext

Call sub_format_excel(str_fqfp & ".xlsx")

If rs1.EOF = True Then
MsgBox "Completed Spreadsheet Heat Map Creation"
Else

str_district_code = rs1!districtCode
str_district_name_trunc = rs1!district_name_trunc
str_fn = "Heat Map - " & str_district_name_trunc
str_fqfp = str_fp & str_fn
End If


Loop


End Sub

Sub sub_format_excel(str_file_name As String)

Dim Xl As Excel.Application
Dim XlBook As Excel.Workbook
Dim int_sheet As Integer

Set Xl = New Excel.Application
Xl.Visible = True

Set XlBook = Xl.Workbooks.Open(str_file_name)


With XlBook

For int_sheet = 1 To .Worksheets.Count

With .Worksheets(int_sheet)


.Range("B1").AutoFilter Field:=3, Criteria1:="E"
With .Range(.Cells(2, 2), .Cells(2, 2).End(xlDown)).Interior
.Color = 15458751
End With

.Range("B1").AutoFilter Field:=3, Criteria1:="H"
With .Range(.Cells(2, 2), .Cells(2, 2).End(xlDown))
.Interior.Color = 7495972
.Font.ThemeColor = xlThemeColorDark1
End With

.Range("B1").AutoFilter Field:=3, Criteria1:="M"
With .Range(.Cells(2, 2), .Cells(2, 2).End(xlDown))
.Interior.Color = 11178551
.Font.ThemeColor = xlThemeColorDark1
End With

.Range("$B$1").AutoFilter Field:=3

.Range("A1").AutoFilter
.Columns("A:E").EntireColumn.EntireColumn.AutoFit

End With

Next int_sheet


End With

XlBook.Save
XlBook.Close


End Sub