For each worksheet......

[Emma Hope]

Hi All,

I have created some VBA that uses DAO to pull some data from MS Access, the
query within Access is a parameter query and uses the Excel tab (worksheet
name) as the parameter, i use "strTabName = ActiveCell.Worksheet.Name" to do
this.

My spreadsheet has 14 tabs, one for each month and a couple of others, i
have to run my code 12 times each time, saying activate the tab and run the
query, each time specifying the tab name.

I want to be able to automate this along the lines of ..... for each
worksheet in range of worksheets 2 to 13 (i don't want to name them if
possible) do the following - activate, then run my code and then repeat for
the next worksheet along.

My code is below if it helps, i didn't write it, i used the knowledge base
and amended it for my data. If anyone can help, please can you help me by
showing me how to change the code below to do this because i am still
learning VBA. For example the Set Ws = Sheets("June") bit and when looping
through the sheets when do i need to set my variables to nothing using .Close
etc.

I have Windows XP and Office 2000. I have added DAO Library 3.6 but no other
references, please let me know if i need any others.

Thanks
Emma


Private Sub CommandButton2_Click()

Dim Db As Database: Dim Qd As QueryDef: Dim Rs As Recordset: Dim Ws As Object
Dim i As Integer: Dim strMonthName As String: Dim strPath As String: Dim
strTabName As String

'Set the Path to the database. This line is useful because
'if your database is in another location, you just need to change
'it here and the Path Variable will be used throughout the code.
strPath = ThisWorkbook.Path & "\Member Database.mdb"


'Set Ws
Set Ws = Sheets("June")

'This set of code will activate Sheet1 and clear any existing data.
'After clearing the data, it will select cell A1.
Ws.Activate
strTabName = ActiveCell.Worksheet.Name
Sheets(strTabName).Range("A1").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Sheets(strTabName).Range("A1").Select

'Set the strings that will be passed as parameters. The strings are
'hard coded, just for the sake of simplicity. But there are lots
'of ways to set these variables.
'NOTE: For Excel 97, change these years to 96.
strMonthName = strTabName

'Set the Database, and RecordSet. This Table exists in the database.
Set Db = Workspaces(0).OpenDatabase(strPath, ReadOnly:=True)
Set Qd = Db.QueryDefs("qryFiguresMemberByWeek")

Qd.Parameters("Specify Month") = strMonthName

'Create a new Recordset from the Query based on the stored QueryDef.
Set Rs = Qd.OpenRecordset()

'This loop will collect the field names and place them in the first
'row starting at "A1."
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next

'The next three lines will get the data from the recordset and copy
'it into the Worksheet (Sheet1).
Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold = True
Ws.Range("A2").CopyFromRecordset Rs

'This next code set selects the data region and auto-fits the columns.
Sheets(strTabName).Select
Sheets(strTabName).Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Sheets(strTabName).Range("A1").Select

Qd.Close
Rs.Close
Db.Close
End Sub

 

[Dick Kusleika]

Hi All,

I have created some VBA that uses DAO to pull some data from MS Access, the
query within Access is a parameter query and uses the Excel tab (worksheet
name) as the parameter, i use "strTabName = ActiveCell.Worksheet.Name" to do
this.

My spreadsheet has 14 tabs, one for each month and a couple of others, i
have to run my code 12 times each time, saying activate the tab and run the
query, each time specifying the tab name.

I want to be able to automate this along the lines of ..... for each
worksheet in range of worksheets 2 to 13 (i don't want to name them if
possible) do the following - activate, then run my code and then repeat for
the next worksheet along.

Try this. I don't know where this code lives, but it appears to live in a
worksheet module behind an ActiveX commandbutton. Remember that you only
have to click the button once and it will process all the sheets between 2
and 13. Post back if you have more questions.

Private Sub CommandButton2_Click()

Dim Db As Database: Dim Qd As QueryDef: Dim Rs As Recordset: Dim Ws As
Object
Dim i As Integer: Dim strMonthName As String: Dim strPath As String: Dim
strTabName As String

'Set the Path to the database. This line is useful because
'if your database is in another location, you just need to change
'it here and the Path Variable will be used throughout the code.
strPath = ThisWorkbook.Path & "\Member Database.mdb"

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

For Each Ws In ThisWorkbook.Worksheets

If Ws.Index >= 2 And Ws.Index <= 13 Then
'This set of code will activate Sheet1 and clear any existing
data.
'After clearing the data, it will select cell A1.
Ws.Range("A1").CurrentRegion.ClearContents

'Set the strings that will be passed as parameters. The strings
are
'hard coded, just for the sake of simplicity. But there are lots
'of ways to set these variables.
'NOTE: For Excel 97, change these years to 96.
strMonthName = Ws.Name

'Set the Database, and RecordSet. This Table exists in the
database.
Set Qd = Db.QueryDefs("qryFiguresMemberByWeek")

Qd.Parameters("Specify Month") = strMonthName

'Create a new Recordset from the Query based on the stored
QueryDef.
Set Rs = Qd.OpenRecordset()

'This loop will collect the field names and place them in the
first
'row starting at "A1."
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next

'The next three lines will get the data from the recordset and
copy
'it into the Worksheet (Sheet1).
Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold
= True
Ws.Range("A2").CopyFromRecordset Rs

'This next code set selects the data region and auto-fits the
columns.
Ws.Range("A1").CurrentRegion.EntireColumn.AutoFit

Qd.Close
Rs.Close
End If
Next Ws

Db.Close

Set Qd = Nothing
Set Rs = Nothing
Set Db = Nothing

End Sub

 

[Emma Hope]

Dick,

This couldn't have worked better! Thank you so much!!

Emma

 

[Dick Kusleika]

Dick,

This couldn't have worked better! Thank you so much!!

I'm glad it helped.