Hi I am adapting my former colleagues VBA so when the VBA runs it firstly:
1)looks at the date in the access table and if this then matches the preset date in my excel worksheet (cells 1, Y..-refer to code below) it then places the value from the next field in my access table to a range of cells further down in my excel worksheet (cells 32,y..-refer to code below)
I keep getting a bunch of errors..currently "compile error: wrong number of properties or invalid property assignment"
I appreciate any help Pleassseee...Please find my code below..Thanks
[/CODE][/CODE][/CODE][/CODE]
Option Compare Database
Option Explicit
Sub Test_Reporta()
Dim AppExcel As Object
Dim LOCReport As Recordset
Dim LOCReport2 As Recordset
Dim CurrentSheet As Variant
Dim SPos As Integer
Dim rpos As Integer
Dim cpos As Integer
Dim i As Integer
Dim j As Integer
Dim count As Integer
Dim datasheet As Variant
Dim Test As Variant
Dim RepType As Integer
Dim Desc As String
Dim StartDate1 As Date
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim EndDate As Date
Dim StartDate As Date
Dim LocC As String
Dim LocL As String
Dim Par1 As Date
Dim Par2 As Date
Dim TeamNo As String
Dim strSql As String
Dim strDateStart As Date
Dim strEndStart As Date
' Stops warnings from appearing
DoCmd.SetWarnings False
' ************************************************** ******************************************
Set AppExcel = CreateObject("excel.application")
AppExcel.Visible = True
' Opens Excel template
'Selects Specialty
Select Case [Forms]![Test]![lstSpecialty]
Case "Cardiac Rehabilitation"
AppExcel.Workbooks.Open "S:\SpecialtyActivityReporting\Cardiac_Rehabilitat ion Activity.xls", , True
End Select
Select Case [Forms]![Test]![lstSpecialty]
Case "Cardiac Rehabilitation"
AppExcel.StatusBar = "Running Average F2f Contact Time"
strSql = "SELECT dbo_vwSchedules.Service, Format([SchduleDate],""yyyymm"") AS [Date], Avg(Round([Duration])) AS AverageDuration INTO tblAvgContactTimeF2F " & vbCrLf & _
"FROM dbo_vwSchedules " & vbCrLf & _
"WHERE (((dbo_vwSchedules.ServiceID) Like ""CAR"") AND ((dbo_vwSchedules.StatusID) Like ""f*"") AND ((dbo_vwSchedules.SchdlTypeID) Like ""c*"") AND ((dbo_vwSchedules.Shared) Is Null) AND ((dbo_vwSchedules.SchduleDate) Between [forms]![Test]![txtStartDate] And [forms]![Test]![txtEndDate])) " & vbCrLf & _
"GROUP BY dbo_vwSchedules.Service, Format([SchduleDate],""yyyymm"");"
DoCmd.RunSQL strSql
Set LOCReport = CurrentDb.OpenRecordset("SELECT tblAvgContactTimeF2F.Service, tblAvgContactTimeF2F.Date, tblAvgContactTimeF2F.AverageDuration FROM tblAvgContactTimeF2F")
'selects named excel worksheett
Set datasheet = AppExcel.ActiveWorkBook.Sheets("RawData")
RepType = 1
Call Report_Run23(LOCReport, datasheet, RepType)
''''AppExcel.StatusBar = "Running Outpatient DNA"
End Select
DoCmd.SetWarnings True
AppExcel.StatusBar = "Run has finished"
MsgBox "Run has finished"
AppExcel.StatusBar = False
End Sub
Private Sub RunAQuery(strQueryName As String)
' Input : strQueryName Name of saved query to run
Dim db As Database
Dim qry As QueryDef
Set db = CurrentDb()
Set qry = db.OpenQuery(strQueryName)
DoCmd.SetWarnings True
qry.Execute
DoCmd.SetWarnings True
qry.Close
db.Close
DoEvents
DBEngine.Idle
End Sub
Public Sub Report_Run23(LOCReport As Recordset, datasheet As Variant, RepType As Integer)
Dim AppExcel As Object
Dim CurrentPG As String
Dim CurrentSheet As Variant
Dim SPos As Integer
Dim rpos As Integer
Dim cpos As Integer
Dim overeight As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim x As Integer
Dim y As Integer
Dim count As Integer
Dim Test1 As Variant
Dim Test2 As Variant
Dim Test3 As Variant
Dim StartDate As Date
Dim EndDate As Date
Dim NewDate As Date
Dim SumTotal As Single
Dim PG As String
Dim Datasheet2 As Variant
' Start position of report data
rpos = 7
cpos = 2
' For 12 month reports
If RepType = 1 Then
End If
' Sets read start to begining of record
LOCReport.MoveFirst
' Counts number of fields in record
j = LOCReport.Fields.count
Select Case [Forms]![Test]![lstSpecialty]
Case "Cardiac Rehabilitation"
k = 37
End Select
Test1 = datasheet.Cells.Value(1, 3)
Test2 = LOCReport.Fields(1).Name
Test3 = LOCReport.Fields(2).Name
StartDate = [Forms]![Test]![txtStartDate]
StartDate = DateAdd("d", -364, EndDate)
' For 12 month reports
While Not LOCReport.EOF
For y = 3 To 14
If LOCReport.Fields(1).Value = datasheet.Cells.Value(1, y) Then
datasheet.Cells.Value(32, y) = LOCReport.Fields(2).Value
End If
'NewDate = DateAdd("m", y - 1, StartDate)
'datasheet.Cells(rpos, cpos + y).Value = DateAdd("m", i - 1, StartDate)
'datasheet.Cells(rpos, cpos + y).NumberFormat = "mmm-yy"
Next y
LOCReport.MoveNext
Wend
LOCReport.Close
End Sub<!-- / message -->
1)looks at the date in the access table and if this then matches the preset date in my excel worksheet (cells 1, Y..-refer to code below) it then places the value from the next field in my access table to a range of cells further down in my excel worksheet (cells 32,y..-refer to code below)
I keep getting a bunch of errors..currently "compile error: wrong number of properties or invalid property assignment"
I appreciate any help Pleassseee...Please find my code below..Thanks
Code:
[CODE][CODE][CODE][CODE]
Option Compare Database
Option Explicit
Sub Test_Reporta()
Dim AppExcel As Object
Dim LOCReport As Recordset
Dim LOCReport2 As Recordset
Dim CurrentSheet As Variant
Dim SPos As Integer
Dim rpos As Integer
Dim cpos As Integer
Dim i As Integer
Dim j As Integer
Dim count As Integer
Dim datasheet As Variant
Dim Test As Variant
Dim RepType As Integer
Dim Desc As String
Dim StartDate1 As Date
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim EndDate As Date
Dim StartDate As Date
Dim LocC As String
Dim LocL As String
Dim Par1 As Date
Dim Par2 As Date
Dim TeamNo As String
Dim strSql As String
Dim strDateStart As Date
Dim strEndStart As Date
' Stops warnings from appearing
DoCmd.SetWarnings False
' ************************************************** ******************************************
Set AppExcel = CreateObject("excel.application")
AppExcel.Visible = True
' Opens Excel template
'Selects Specialty
Select Case [Forms]![Test]![lstSpecialty]
Case "Cardiac Rehabilitation"
AppExcel.Workbooks.Open "S:\SpecialtyActivityReporting\Cardiac_Rehabilitat ion Activity.xls", , True
End Select
Select Case [Forms]![Test]![lstSpecialty]
Case "Cardiac Rehabilitation"
AppExcel.StatusBar = "Running Average F2f Contact Time"
strSql = "SELECT dbo_vwSchedules.Service, Format([SchduleDate],""yyyymm"") AS [Date], Avg(Round([Duration])) AS AverageDuration INTO tblAvgContactTimeF2F " & vbCrLf & _
"FROM dbo_vwSchedules " & vbCrLf & _
"WHERE (((dbo_vwSchedules.ServiceID) Like ""CAR"") AND ((dbo_vwSchedules.StatusID) Like ""f*"") AND ((dbo_vwSchedules.SchdlTypeID) Like ""c*"") AND ((dbo_vwSchedules.Shared) Is Null) AND ((dbo_vwSchedules.SchduleDate) Between [forms]![Test]![txtStartDate] And [forms]![Test]![txtEndDate])) " & vbCrLf & _
"GROUP BY dbo_vwSchedules.Service, Format([SchduleDate],""yyyymm"");"
DoCmd.RunSQL strSql
Set LOCReport = CurrentDb.OpenRecordset("SELECT tblAvgContactTimeF2F.Service, tblAvgContactTimeF2F.Date, tblAvgContactTimeF2F.AverageDuration FROM tblAvgContactTimeF2F")
'selects named excel worksheett
Set datasheet = AppExcel.ActiveWorkBook.Sheets("RawData")
RepType = 1
Call Report_Run23(LOCReport, datasheet, RepType)
''''AppExcel.StatusBar = "Running Outpatient DNA"
End Select
DoCmd.SetWarnings True
AppExcel.StatusBar = "Run has finished"
MsgBox "Run has finished"
AppExcel.StatusBar = False
End Sub
Private Sub RunAQuery(strQueryName As String)
' Input : strQueryName Name of saved query to run
Dim db As Database
Dim qry As QueryDef
Set db = CurrentDb()
Set qry = db.OpenQuery(strQueryName)
DoCmd.SetWarnings True
qry.Execute
DoCmd.SetWarnings True
qry.Close
db.Close
DoEvents
DBEngine.Idle
End Sub
Public Sub Report_Run23(LOCReport As Recordset, datasheet As Variant, RepType As Integer)
Dim AppExcel As Object
Dim CurrentPG As String
Dim CurrentSheet As Variant
Dim SPos As Integer
Dim rpos As Integer
Dim cpos As Integer
Dim overeight As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim x As Integer
Dim y As Integer
Dim count As Integer
Dim Test1 As Variant
Dim Test2 As Variant
Dim Test3 As Variant
Dim StartDate As Date
Dim EndDate As Date
Dim NewDate As Date
Dim SumTotal As Single
Dim PG As String
Dim Datasheet2 As Variant
' Start position of report data
rpos = 7
cpos = 2
' For 12 month reports
If RepType = 1 Then
End If
' Sets read start to begining of record
LOCReport.MoveFirst
' Counts number of fields in record
j = LOCReport.Fields.count
Select Case [Forms]![Test]![lstSpecialty]
Case "Cardiac Rehabilitation"
k = 37
End Select
Test1 = datasheet.Cells.Value(1, 3)
Test2 = LOCReport.Fields(1).Name
Test3 = LOCReport.Fields(2).Name
StartDate = [Forms]![Test]![txtStartDate]
StartDate = DateAdd("d", -364, EndDate)
' For 12 month reports
While Not LOCReport.EOF
For y = 3 To 14
If LOCReport.Fields(1).Value = datasheet.Cells.Value(1, y) Then
datasheet.Cells.Value(32, y) = LOCReport.Fields(2).Value
End If
'NewDate = DateAdd("m", y - 1, StartDate)
'datasheet.Cells(rpos, cpos + y).Value = DateAdd("m", i - 1, StartDate)
'datasheet.Cells(rpos, cpos + y).NumberFormat = "mmm-yy"
Next y
LOCReport.MoveNext
Wend
LOCReport.Close
End Sub<!-- / message -->