Setting a range object & applying table style

[bigal.nz]

Hi All,

I am creating a spreadsheet from MS Access via VBA - and this works well. I am running into problems however setting a table style to a range in the Excel file.

It doesn't seem to apply the style, and occasionally throws a error which I don;t have handy right now but will add it if I can reproduce.


My code is:



Private Sub btn_Excel_NG_Click()
Dim rst As DAO.Recordset
Dim strSQL As String
Dim qdfnew As DAO.QueryDef
Dim RecordCount As String
Dim xl As Excel.Application
Dim wb As Object

' ***********************
' ** CREATE QUERY
' ***********************

strSQL = "SELECT TABLE.Event, DateStart, Suburb, FirstName, Name, Home, DOB, FROM SAM INNER JOIN tbl_records ON Table.Event = tbl_records.Event WHERE (tbl_records.NGEmailed Is Null);"

' ***********************
' ** EXPORT TO EXCEL FILE
' ***********************


Set qdfnew = CurrentDb.CreateQueryDef("excelQuery", strSQL)
FileName = "S:\Hub\Processed\Email\" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"
DoCmd.TransferSpreadsheet acExport, 10, "excelQuery", FileName, True
DoCmd.Close acQuery, "excelQuery"
CurrentDb.QueryDefs.Delete qdfnew.Name

' ********************
' ** FORMAT EXCEL FILE
' ********************

Set xl = New Excel.Application
Set wb = xl.Workbooks.Open(FileName)

With wb.Sheets(qdfnew.Name)
.rows("1:1").Font.Bold = True
.Columns("A:Z").AutoFit
End With

Dim tbl As ListObject
Dim rng As Range

Worksheets(qdfnew.Name).Activate
Set rng = Range("A50:N50") ' <- HOW CAN I MAKE THIS THE ALL DATA RATHER THAN HARD CODE
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
tbl.TableStyle = "TableStylemedium2"

Set tbl = Nothing
wb.Save
wb.Close
Set wb = Nothing
xl.Quit
Set xl = Nothing


End Sub


Thanks in advance,

-Al

[mdmackillop]

Set Rng = Range("A50:N50") ' <- HOW CAN I MAKE THIS THE ALL DATA RATHER THAN HARD CODE

Is the data "isolated", If so try


Set Rng = Range("A50:N50").CurrentRegion

[bigal.nz]

Ok,

The error that is coming up is:

Run-time error '1004':
Method 'Worksheets' of object '_Global' failed

and it is on the line:



Worksheets(qdfnew.Name).Activate


It only comes up every other time I run the program.

I think it is something to do with the way the workbook is declared:

Dim wb As Object - perhaps should be Dim wb As Excel.Worksheet - and I think when I refer to the range object it needs to be a fully qualified reference, but I am trying to work out what this reference should look like.

I hope this helps?

Cheers

-Al

[mdmackillop]

You're losing the scope of the wb object.
Try

wb.Sheets(qdfnew.Name).activate

This adds a worksheet object to pull things together (hopefully)

Private Sub btn_Excel_NG_Click()
Dim rst As DAO.Recordset
Dim strSQL As String
Dim qdfnew As DAO.QueryDef
Dim RecordCount As String
Dim xl As Excel.Application
Dim wb As Object
Dim ws As Object
Dim tbl As ListObject
Dim rng As Range
' ***********************
' ** CREATE QUERY
' ***********************


strSQL = "SELECT TABLE.Event, DateStart, Suburb, FirstName, Name, Home, DOB, FROM SAM INNER JOIN tbl_records ON Table.Event = tbl_records.Event WHERE (tbl_records.NGEmailed Is Null);"


' ***********************
' ** EXPORT TO EXCEL FILE
' ***********************




Set qdfnew = CurrentDb.CreateQueryDef("excelQuery", strSQL)
Filename = "S:\Email for NGOs\" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"
DoCmd.TransferSpreadsheet acExport, 10, "excelQuery", Filename, True
DoCmd.Close acQuery, "excelQuery"
CurrentDb.QueryDefs.Delete qdfnew.Name


' ********************
' ** FORMAT EXCEL FILE
' ********************


Set xl = New Excel.Application
Set wb = xl.Workbooks.Open(Filename)
Set ws = wb.Sheets(qdfnew.Name)


With ws
.Rows("1:1").Font.Bold = True
.Columns("A:Z").AutoFit
Set rng = .Range("A50:N50") ' <- HOW CAN I MAKE THIS THE ALL DATA RATHER THAN HARD CODE
Set tbl = .ListObjects.Add(xlSrcRange, rng, , xlYes)
tbl.TableStyle = "TableStylemedium2"
End With


Set tbl = Nothing
wb.Save
wb.Close
Set wb = Nothing
xl.Quit
Set xl = Nothing




End Sub

[bigal.nz]

Thanks for the reply - testing it now. Can you please check your PM re post?

Also there are now no errors, and the bold and the autofit get applied (although they were before too) but the Table Style is not applied.

Code now looks like this:




Private Sub btn_Excel_NG_Click()
Dim rst As DAO.Recordset
Dim strSQL As String
Dim qdfnew As DAO.QueryDef
Dim RecordCount As String
Dim xl As Excel.Application
Dim wb As Object
Dim ws As Object
Dim rng As Range
Dim tbl As ListObject


' ***********************
' ** CREATE QUERY
' ***********************

strSQL = "SELECT Event, DateStart, Suburb, FirstName, WHERE etc etc etc ;"

' ***********************
' ** EXPORT TO EXCEL FILE
' ***********************


Set qdfnew = CurrentDb.CreateQueryDef("excelQuery", strSQL)
FileName = "S:\Hub\Processed\Email\" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"
DoCmd.TransferSpreadsheet acExport, 10, "excelQuery", FileName, True
DoCmd.Close acQuery, "excelQuery"
CurrentDb.QueryDefs.Delete qdfnew.Name

' ********************
' ** FORMAT EXCEL FILE
' ********************

Set xl = New Excel.Application
Set wb = xl.Workbooks.Open(FileName)
Set ws = wb.Sheets(qdfnew.Name)

With ws
.Rows("1:1").Font.Bold = True
.Columns("A:Z").AutoFit
Set rng = .Range("A50:N50")
Set tbl = .ListObjects.Add(xlSrcRange, rng, , xlYes)
tbl.TableStyle = "TableStylemedium2"
End With

Set tbl = Nothing
wb.Save
wb.Close
Set wb = Nothing
xl.Quit
Set xl = Nothing


End Sub

[bigal.nz]

My bad - I needed to change A50:N50 to A1:N50 - although I will try to get this working with xlLastCell

[mdmackillop]

Try range("A1") .CurrentRegion (if appropriate)

[bigal.nz]

I got it to work with your method and Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))

Now i just need to insert a new cell at the end of the range before formatting.

I have counted the colums in the range, guess I need to +1 then insert? Then redefine range?

-A

[snb]

or ?


Private Sub M_snb()
c00 = "S:\Hub\Processed\Email\" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"

CurrentDb.CreateQueryDef "excelQuery", "SELECT TABLE.Event, DateStart, Suburb, FirstName, Name, Home, DOB, FROM SAM INNER JOIN tbl_records ON Table.Event = tbl_records.Event WHERE (tbl_records.NGEmailed Is Null);"
DoCmd.TransferSpreadsheet acExport, 10, "excelQuery", c00, True
DoCmd.Close acQuery, "excelQuery"
CurrentDb.QueryDefs.Delete "excelQuery"

With GetObject(c00)
.Sheets(1).ListObjects.Add(1, .Sheets(1).Cells(1).CurrentRegion, , xlYes).TableStyle = "TableStylemedium2"
.Close -1
End With
End Sub

PS I don't see the need to create a new tabelquery and delete it afterwards ? I think it can be permanent and applied every time you need it in this macro.

[Paul_Hossler]

I got it to work with your method and Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))

Now i just need to insert a new cell at the end of the range before formatting.

I have counted the colums in the range, guess I need to +1 then insert? Then redefine range?



IF you just use



set rng = ws.Range("A1") .CurrentRegion



and your table is one 'block' of data containing A1 (ex. A1:N50) rng will be set to the entire block A1:N50


If your table is one 'block' of data containing A1 (ex. A1:Z123) rng will be set to the entire block A1:Z123