Exporting Access forms to specific locations in excel

[Michael Banks]

Hello
I am looking at exporting values of a continuous form into specific
locations in an excel spreadsheet. I have office 2k.

I have a form that generates a continuous subform after a month is
selected from a combobox. The subform shows all completions in that
month for each location. i.e. in May location 1 had 100 completions,
location 3 235, location 4 had 100. Location 2 didn't have any
therefore doesn't show up in the subform. Each month different
locations will show up.

I would like to export that data into excel via vba and paste it into a
specific location. I currently have an excel spreadsheet with months
across the top of the spreadsheet in row 1 and the all possible
locations along column A. How would I go about having the data from the
subform paste into the correct location in excel. It needs to look at
the combobox in the form to find the month and look at each location to
make sure it gives the right location correct amount completed.

Thanks
Mike

 

[Andy Korth]

I've done the same thing. Here's what I did:

DoCmd.Hourglass True

Dim oApp As Object
Set oApp = CreateObject("Excel.Application")
oApp.Visible = False
oApp.UserControl = False
oApp.Workbooks.Open FileName:=CurrentProject.Path
& "\FS Plot Highlighter.xls"
Counter = 1

While oApp.Range("B" & Counter).Value <> ""
oApp.Rows(Counter & ":" & Counter + 50).delete
'efficency. I delete them 50 at a time!
Wend

Dim arrPlots(194) As Integer ' a little extra room
Dim CountedRecs As Integer
Dim rst2 As DAO.Recordset
Dim intI As Integer
Set rst2 = Forms![GenerateRecords]![Plots by
Operation subform].Form.RecordsetClone
With rst2
.MoveLast
.MoveFirst
CountedRecs = .RecordCount
For intI = 1 To CountedRecs
arrPlots(intI - 1) = ![Plot]
.MoveNext
Next intI
End With
rst2.Close
Set rst2 = Nothing

oApp.Worksheets("Formatted Plot Design").Activate

'THEN! I used code like that which is below to send my
array with all my info into excel. You could skip this
step and, instead of writing an array, do Cells("A" &
i).value above inside that For loop.

Counter = 54 'or whatever
oApp.Range("A" & Counter).Value = [Insecticide]
oApp.Range("D" & Counter).Value = [IRate]
oApp.Range("E" & Counter).Value = [IUnit]

DoCmd.Hourglass False
'*********************************************
'Done highlighting, turn over to user
oApp.Sheets("Formatted Plot Design").Select
oApp.Visible = True
oApp.UserControl = True
oApp.Range("A1").Select

end sub

I hope you get the idea. You could also use DLookup. To
copy to excel, I've had the most luck with the Cells
function. The associated help files should have more info.

Andy

 

[Andy Korth]

DOH!
You caught me, I was planning to destroy your entire file
with my delete row commands!
Actually, sorry about that. I meant to take it out. I
have that in my file to get rid of old stuff. There's a
lot more code of mine that I took out. What that code
actually does (if it was all there) would be to highlight
certain cells matching criteria.
But anyway, take that out.

In the subform I have two fields. Service_Center and Inspections. I
want to take the Service_Center from the form find it in the spreadsheet
and populate the Inspections value under the appropriate month. Thanks
again

oApp.Range("A1").Value = [Service_Center]

This will put the value of Service_Center into the cell
A1 of the active sheet. (I guess you need ActivateSheet
too...)

You won't need:

Dim arrPlots(194) As Integer ' a little extra room
Dim CountedRecs As Integer
Dim rst2 As DAO.Recordset
Dim intI As Integer
Set rst2 =
Forms![frmCompletions]! [subfrmXFMRCompletions].Form.RecordsetClone
With rst2
.MoveLast
.MoveFirst
CountedRecs = .RecordCount
' For intI = 1 To CountedRecs
' arrPlots(intI - 1) = ![Plot]
' .MoveNext
' Next intI
End With
rst2.Close
Set rst2 = Nothing

Unless you are doing a lot of records. I did 192, hence
the array with 194 elements.

Now, you don't always want your data in Cell A1, so you
will need to go though the cells with a counter,
searching for the month that you want the data under.

While oApp.Range("B" & Counter).Value <> [Service_Center]
Counter = Counter + 1
Wend

then when it finds the value you want, write the
inspection value.

I'm not sure if this makes any sense...

You said:

In the subform I have two fields. Service_Center and Inspections. I
want to take the Service_Center from the form find it in the spreadsheet
and populate the Inspections value under the appropriate

month.

Would the appropriate month be this month? cause then
you'd need a little more code and the Date() function.

Andy

-----Original Message-----
Andy,

Thanks for the help. I have a couple of questions on what you are doing
with your code though. When you are running your while loop to delete
the records, what is the "B" & Counter is that your cell location of
where you are deleting?

I have commented that out since I don't want to delete anything, I just
want to add records to the spreadsheet under the month selected heading.

My code now looks like this:

Public Function test()

DoCmd.Hourglass False

Dim oApp As Object
Set oApp = CreateObject("Excel.Application")
oApp.Visible = False
oApp.UserControl = False
oApp.Workbooks.Open Filename:=CurrentProject.Path &
"\URDCompletions.xls"
Counter = 1

'While oApp.Range("B" & Counter).Value <> ""
' oApp.Rows(Counter & ":" & Counter + 50).Delete
' 'efficency. I delete them 50 at a time!
'Wend

Dim arrPlots(194) As Integer ' a little extra room
Dim CountedRecs As Integer
Dim rst2 As DAO.Recordset
Dim intI As Integer
Set rst2 =
Forms![frmCompletions]! [subfrmXFMRCompletions].Form.RecordsetClone
With rst2
.MoveLast
.MoveFirst
CountedRecs = .RecordCount
' For intI = 1 To CountedRecs
' arrPlots(intI - 1) = ![Plot]
' .MoveNext
' Next intI
End With
rst2.Close
Set rst2 = Nothing

oApp.Worksheets("XFMR Monthly Completions").Activate

'THEN! I used code like that which is below to send my array with all my
info into excel.
'You could skip this step and, instead of writing an array, do Cells("A"
& i).value above inside that For loop.

Counter = 54
oApp.Range("A" & Counter).Value = [Service_Center]

'DoCmd.Hourglass False
'*********************************************
'Done highlighting, turn over to user
oApp.Sheets("URDCompletions").Select
oApp.Visible = True
oApp.UserControl = True
oApp.Range("A1").Select

End Function


Mike