VBA Automation from Access to Excel help

M

mattaus

Registered User.
Local time
Today, 03:45
Joined
Apr 27, 2009
Messages
35
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

I have also attached the excel worksheet where the the vba will be reading and matching the date and where it will be placing the value


Public Sub Report_Run23(LOCReport As Recordset, datasheet As Variant, RepType As Integer) 'OUTPATINETS FOLLOW-UP'
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
 

Attachments

Last edited:
Thank you for completing your previous post with a "I found the problem, thanks o supreme uber great fantastic supercalefragelistic majestic mr mailman.." or something simular ;)

http://www.access-programmers.co.uk/forums/showthread.php?t=171741

Now about your code...
StartDate = DateAdd("d", -364, EndDate)
You do know you can move a date back a year as well right??

I sure hope you do normaly indent your code like I did in the other post! This keeps it readable and maintainable!

As for your problem....
You are defining all kinds of variables that you are not using, why define them?? If they are beeing defined and this is only part of your code, please post the full code AND use the [ code ] and [/ code ] (without the spaces) around the code when you post it.

Finaly... What is Datasheet? It is a fully qualified reference to excel?
 
lol Thanks

This is my first VBA code I am writing and I am learning it at the same time so I will indent from now on...

I am not using all of the variables-they were in from the last code as i am just trying to adapt this code..I will put the full code below...

yes sorry the datasheet is a worksheet in excel

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_Rehabilitation 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
 
Since you are not really answering any of the questions I will simply repeat...

namliam said:
As for your problem....
You are defining all kinds of variables that you are not using, why define them?? If they are beeing defined and this is only part of your code, please post the full code AND use the [ code ] and [/ code ] (without the spaces) around the code when you post it.

Finaly... What is Datasheet? It is a fully qualified reference to excel?
Click to expand...
 
As i mentioned above i am not using all the variables they are in from a previous code and they are still in as i don't belive they are affecting the code.. i can take them out?

also Datasheet is a reference to excel ( a worksheet in excel)!
 
reformated the code a little bit....
Code: 
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_Rehabilitation Activity.xls", , True
    
    End Select
    
    Select Case [Forms]![Test]![lstSpecialty]
        Case "Cardiac Rehabilitation"
        
            AppExcel.StatusBar = "Running Average F2f Contact Time"
            strSql = ""
            strSql = strSql & " SELECT dbo_vwSchedules.Service, Format([SchduleDate],""yyyymm"") AS [Date], Avg(Round([Duration])) AS AverageDuration "
            strSql = strSql & " INTO tblAvgContactTimeF2F " & vbCrLf
            strSql = strSql & " FROM dbo_vwSchedules " & vbCrLf & _
            strSql = strSql & " WHERE (((dbo_vwSchedules.ServiceID) Like ""CAR"") "
            strSql = strSql & "   AND ((dbo_vwSchedules.StatusID) Like ""f*"") "
            strSql = strSql & "   AND ((dbo_vwSchedules.SchdlTypeID) Like ""c*"") "
            strSql = strSql & "   AND ((dbo_vwSchedules.Shared) Is Null) "
            strSql = strSql & "   AND ((dbo_vwSchedules.SchduleDate) Between [forms]![Test]![txtStartDate] "
            strSql = strSql & "                                          And [forms]![Test]![txtEndDate])) " & vbCrLf & _
            strSql = strSql & "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

The only thing I can spot, without knowing where the error is (what is it highlighting??)
datasheet.Cells.Value(32, y) and datasheet.Cells.Value(1, y)
This should (I think) be datasheet.Cells(32, y).Value or datasheet.Cells(1, y).Value
Is it is done in the commented out lines below:
datasheet.Cells(rpos, cpos + y).Value = DateAdd("m", i - 1, StartDate)
 
I have altered the code to show:

Code:
If LOCReport.Fields(1) = Datasheet.Cells(1, y).Value Then
Datasheet.Cells(32, y).Value = LOCReport.Fields(2)
End If


Its going through the run correctly finishing with 'Run has finished', howver it is not copying the figuers to the excel datasheet..?

I have used the my mouse to hover over the above code "Datasheet.Cells(1, y).Value" however it dosnt seem to the reading the datasheet as its not showing any output..
 
Thats because the datasheet is supposed to be recieving not give the data.
LOCReport.Fields(2).Value should be containing the data.
 
Yes sorry that is correct, the datasheet dosnt seem to be reciving the data from LOCReport.Field(2).Value........?
 
If LOCReport.Fields(1) = Datasheet.Cells(1, y).Value Then
Datasheet.Cells(32, y).Value = LOCReport.Fields(2)
End If

You are sure the values are equal on the IF line?? You could try something like:
Code: 
If LOCReport.Fields(1) = Datasheet.Cells(1, y).Value Then
    Stop
    Datasheet.Cells(32, y).Value = LOCReport.Fields(2)
End If
 
I will give it ago and I'll get back to you...Thanks
 
You must log in or register to reply here.

Similar threads

N
Solved How get lid of domain function and replace them with opening recordset in MS Access VBA
Replies
10
Views
493
nector
N
N
How to send filtered transactions in the MS Access Combo box with one Click
Replies
15
Views
883
Mark_
M
zelarra821
Solved Protect VBA Project Programmatically with SendKeys
Replies
12
Views
1,905
zelarra821
zelarra821
N
Solved Failing To Save Imported Data from the internet in Ms Access
Replies
6
Views
1,197
nector
N
C
Error 3828 when exporting queries to Excel
2
Replies
34
Views
2,041
ChrisMore
C

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom