VBA Automation from Access to Excel help

mattaus11

New Member
Joined
May 12, 2009
Messages
10
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][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 -->
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Forum statistics

Threads
1,215,611
Messages
6,125,829
Members
449,266
Latest member
davinroach

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top