Tech Support Guy banner
Cancel

Accessing heading in Transform Pivot within Access VBA

820 Views 14 Replies 2 Participants Last post by  Charmian, 
C
I'm using a transform Pivot SQL from within Access VBA to create the data I need to build a report in Excel. This report will be used by the user. the data comes from committees held across a year, and the various attendees. I don't want large gaps with all the dates being across the transform, so I run it for each committee, create/write the details to the Excel output file, and then run it again for the next committee. I could do it in a query and produce a report in native Access for each committee, but this would entail the user having to put it together and this, I know, won't be done. (There are 36 committees, with up to 50 memberships in each committee).
But when I create the transform Pivot query, it works perfectly, but how to I access the headings that have the actual meeting dates in them, within the VBA?
If I run as just an SQL the Result has headings
ABR, ID, MemberName, TotalAtt, TotalMeet,yyyy/mm/dd, yyyy/mm/dd of all the meetings repeating.
It's THOSE dates that I want to get hold of to write as headings when populating my excel.
sql2 = "TRANSFORM Sum(MeetingAttendance.Attend) AS SumOfAttend " & _
" SELECT MeetingAttendance.ABR, MeetingAttendance.MemCat, [Surname] & """ & "," & """ & [Title] & """ & " " & """ & [Initials] AS MemName, Sum(([Attend]*-1)) AS TotalAtt, Count(MeetingAttendance.MeetingDate) AS TotalMeet " & _
" FROM CommitteeMemberNames INNER JOIN MeetingAttendance ON CommitteeMemberNames.ID = MeetingAttendance.ID " & _
" WHERE MeetingAttendance.ABR = """ & pdb!ABR & """" & _
" GROUP BY MeetingAttendance.ABR, MeetingAttendance.Memcat,MeetingAttendance.sortcode, MeetingAttendance.ID, [Surname] & """ & "," & """ & [Title] & """ & " " & """ & [Initials] " & _
" PIVOT MeetingAttendance.MeetingDate ;"

'MsgBox "now were about to go to the 2nd do while"
Set Atd = CurrentDb.OpenRecordset(sql2)
See less See more
Save
Like
Status
Not open for further replies.
1 - 15 of 15 Posts
O
Try this test.
Dim fieldcount as integer
and then after Set Atd = CurrentDb.OpenRecordset(sql2)
Atd.movefirst
With Atd
For fieldcount = 1 To 5 'you need to change this to the actual number of fields that you have in
msgbox .Fields(fieldcount).name
next fieldcount
end with

This should provide a msgbox for each field and give it's name.
But if you create a query and Link to it from Excel or copy it to Excel it should include the Heading titles, doesn't it do that?
See less See more
Save
Like
C
Hi OBP
This should provide a msgbox for each field and give it's name.
But if you create a query and Link to it from Excel or copy it to Excel it should include the Heading titles, doesn't it do that?
I'm going to try this - I wonder if I can write all the results of the transforms (I'm running it for each committee in pdb) to the same Excel? Then each should have the headings (dates of meetings) required for that committee. This will actually be the best solution. I'm going to give that a try.
Save
Like
C
okay. Now I really don't know where to look. I've made my code neater, I've corrected the lnglastrowdata and lnglastdatarow error:rolleyes: :oops:2 open rows are being left between committees, but no headings are being written. Anyone got any ideas?:confused:
If RecordCount <> 0 Then
With xlApp 'we have input - get the headings for the excel
.Visible = False
.UserControl = True
lnglastdatarow = .Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row 'the last populated row.
lnglastdatarow = lnglastdatarow + 1 ' the new heading row
Atd.MoveFirst

With Worksheets("Sheet1") 'this section is to get the heading columns and actually put them into the excel file
For fieldcount = 1 To Atd.Fields.Count ' for every column
.Cells(lnglastdatarow, fieldcount).Value = Atd.Fields(fieldcount - 1).Name ' this displays a heading value , but doesn't get put into the excel file.
Next fieldcount
End With

lnglastdatarow = lnglastdatarow + 1 'where the Atd data must go
.Worksheets("Sheet1").Range("A" & CStr(lnglastdatarow)).CopyFromRecordset Atd 'this part is working!

End With
See less See more
Save
Like
O
So you are getting the Field names, but it doesn't put it in Excel?
Have you tried assigning it to a String?

It is possible that using .cells().value is preventing the string being placed in the Cell, try taking off the .value.
Save
Like
C
I don't know how to assign it to a string.
I removed the .value but still no luck. I also tried an Insert (see below) I can't find an WRITE for this
With Worksheets("Sheet1")
For fieldcount = 1 To Atd.Fields.Count ' for every column
.Cells(lnglastdatarow, fieldcount) = Atd.Fields(fieldcount - 1).Name '(removed . value from fieldcount
diditarrive = Worksheets("sheet1").Cells(lnglastdatarow, fieldcount).Value
MsgBox ActiveCell.Value & " atd " & Atd.Fields(fieldcount - 1).Name & " did it arrive " & diditarrive 'ActiveCell.Value is always blank, but the other 2 are there.
Next fieldcount
End With
xlSht.Rows(CStr(lnglastdatarow)).Insert 'How should this change to write it in the open workbook("Sheet1") the below didn't work either.
'.Worksheets("Sheet1").Rows(CStr(lnglastdatarow)).Insert
lnglastdatarow = lnglastdatarow + 1 'where the atd data must go
.Worksheets("Sheet1").Range("A" & CStr(lnglastdatarow)).CopyFromRecordset Atd 'this part is working!

End With
See less See more
Save
Like
O
OK, to use a string
dim fieldname as string
and then
fieldname = Atd.Fields(fieldcount - 1).Name
msgbox fieldname
will tell you if fieldname now has the field title.

Did you look at linking directly to the query in Excel?
Save
Like
C
Didn't look at linking the query in excel - because the output is for all the different committees and their dates. And different sets of committees have various sub committees. How do I get the fieldname string to write into the excel at the row required? The headings are being found, just not written out to the excel row.
Save
Like
O
I assume that the data is going in the correct rows, so try
With Worksheets("Sheet1")
For fieldcount = 1 To Atd.Fields.Count ' for every column
fieldstring = Atd.Fields(fieldcount - 1).Name
.Cells(lnglastdatarow, fieldcount) = fieldstring '(removed . value from fieldcount
diditarrive = Worksheets("sheet1").Cells(lnglastdatarow, fieldcount).Value
MsgBox ActiveCell.Value & " atd " & Atd.Fields(fieldcount - 1).Name & " did it arrive " & diditarrive 'ActiveCell.Value is always blank, but the other 2 are there.
Next fieldcount
End With
I will take a shot at it later after I have done grandchildren sitting.
Save
Like
C
Thanks OBP. The data is there, just doesn't get to the workbook. I added a
xlSht.Cells(lnglastdatarow , fieldcount).Insert but still nothing gets put into the excel spreadsheet. All the data is appended beautifully!
Save
Like
C
PS VEry jealous of the grandkids - I need to marry off my brood!
Save
Like
O
Before attempting this myself I looked and my VBA collection and came across this
For lngColumn = 0 To rst.Fields.count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Which is basically what you were using and as this came from someone else I can't see why yours is not working.
Are you sure that the data is not being overwritten by the recordset data?

The grandkids have been hard work in the past but now they are 15 & 17 it is not so bad, but I am 71 and the Wife 69 so I am glad it is.
Save
Like
C
So weird. I must be creating my excel incorrectly. I stopped writing the body and the headings appeared, but not in the filename I expect - as book1. It requests if I want to save it and then when I save, the name seems to 'flash' and then the headings are replaced by the data. My error must lie in the definition of Sheet1 - I will look into it. Thank you for being so patient. My actual kids are in their 20's now. I am so ready to move on to the next stage of my life. Somedays, I am just over parenting!:D
Save
Like
O
Good luck with both the VBA and the Kids.
Try saving the sheet after the data import perhaps?
Save
Like
C
Hi All, This works now - all I did was change the with Worksheets("Sheet1") to With XlSht (which is Set to Worksheets("Sheet1") - So I just don't know; somedays you are just meant to not achieve!
Set Atd = CurrentDb.OpenRecordset(sql2)
RecordCount = Atd.RecordCount
If RecordCount <> 0 Then
With xlApp 'we have input - get the headings for the excel
.Visible = False
.UserControl = True
lnglastdatarow = .Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row 'the last populated row.
lnglastdatarow = lnglastdatarow + 2 ' the new heading row 'leave a gap between committees
Atd.MoveFirst
totfields = Atd.Fields.Count - 1 ' we have the number of columns
fieldstringtot = " "
With xlSht
For fieldcount = 1 To Atd.Fields.Count ' for every column
fieldstring = Atd.Fields(fieldcount - 1).Name
fieldstringtot = fieldstringtot & fieldstring
.Cells(lnglastdatarow, fieldcount).Value = fieldstring '(put . value back
Next fieldcount
End With
lnglastdatarow = lnglastdatarow + 1 'where the atd data must go
.Worksheets("Sheet1").Range("A" & CStr(lnglastdatarow)).CopyFromRecordset Atd
'this part is working!

End With
End If
See less See more
Save
Like
1 - 15 of 15 Posts
Status
Not open for further replies.
Tech Support Guy
A forum community dedicated to tech experts and enthusiasts. Come join the discussion about articles, computer security, Mac, Microsoft, Linux, hardware, networking, gaming, reviews, accessories, and more!
Full Forum Listing
Explore Our Forums
Hardware Virus & Other Malware Removal Off Topic Lounge Thread Games & Discussion Networking
Top