VBA pivot table problem

[greenguy]

Howdy to anyone who reads this. I have a pivot table pulling information out of MS Access that is created using VBA. There is a form the user will use to select the first week then the pivot table will be populated with that week plus the 3 previous weeks. My problem is it only works up to week 17 for some reason. So, when I select 17 I get 17,16,15,14. When I select Week 18 I get 17,16,15. When I select 20 I get 20 and 17. I'm just wondering what in the heck is going on here with my code. Sorry for the long post and thanks in advance.



Sub FourWeekData(strweeknum, intweek, stryear)
Dim wk1
Dim wk2
Dim wk3
Dim wk4
Dim struser As String

Unload frmdefects
Sheets("Data").Select
Cells.Clear
intweek = CInt(strweeknum)
wk4 = intweek
wk3 = intweek - 1
wk2 = intweek - 2
wk1 = intweek - 3

wk4 = CStr(wk4)
wk3 = CStr(wk3)
wk2 = CStr(wk2)
wk1 = CStr(wk1)

On Error GoTo ErrExit
struser = Environ("USERNAME")
Sheets("Data").Activate
With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
.Connection = Array(Array( _
"ODBC;DBQ=C:\Documents and Settings\" & struser & "\Desktop\MSSQLmachining.mdb;DefaultDir=C:\Documents and Settings\mtaylor\Desktop;Driver={D" _
), Array( _
"river do Microsoft Access (*.mdb)};DriverId=25;FIL=MS Access;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;" _
), Array("Threads=3;UserCommitSync=Yes;"))
.CommandType = xlCmdSql
.CommandText = Array( _
"SELECT QRYmainscreenscrap.Area, QRYmainscreenscrap.Shift, QRYmainscreenscrap.Category, QRYmainscreenscrap.Reason, QRYmainscreenscrap.Qty, QRYmainscreenscrap.`Week Number`, QRYmainscreenscrap.Year" & Chr(13) & "" & Chr(10) & "FRO" _
, _
"M `C:\Documents and Settings\mtaylor\Desktop\MSSQLmachining`.QRYmainscreenscrap QRYmainscreenscrap" & Chr(13) & "" & Chr(10) & "WHERE (QRYmainscreenscrap.`Week Number`='" & wk1 & "') AND (QRYmainscreenscrap.Year='" & stryear & "') OR (QRYmainscreensc" _
, _
"rap.`Week Number`='" & wk2 & "') AND (QRYmainscreenscrap.Year='" & stryear & "') OR (QRYmainscreenscrap.`Week Number`='" & wk3 & "') AND (QRYmainscreenscrap.Year='" & stryear & "') OR (QRYmainscreenscrap.`Week Number`='" & wk4 & "') AND (QRYmainscreensc" _
, "rap.Year='" & stryear & "')")
.CreatePivotTable TableDestination:="[4RobBergmann.xls]Data!R3C1", _
TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion10
End With
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Area")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Shift")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Week Number")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Category")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Reason")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Qty"), "Sum of Qty", xlSum
ActiveWorkbook.ShowPivotTableFieldList = False


Call MakeChart
Exit Sub
ErrExit:
MsgBox "There was a problem communicating with the database!", vbCritical + vbOKOnly, "Communication Error"
MsgBox Err.Number & vbCrLf & Err.Description
End Sub

 

[Call_Me_Sam]

Sub FourWeekData(strweeknum, intweek, stryear)
Dim wk1
Dim wk2
Dim wk3
Dim wk4
Dim struser As String

...
intweek = CInt(strweeknum)
wk4 = intweek
...

wk4 = CStr(wk4)
...

Impressive way of getting data. I was curious why you received the weeknumber as a string, converted it so you could subtract 1 to 3 from it then convert it back. Small point that may be causing conflicts. But as good programming i was taught to declare variables with intended data types.

But without actually seeing what the database looks like, ie datatypes in the tables it's difficult to see why it's happening. I note even the year is a string type.

 

[greenguy]

Thx for the reply Call_Me_Sam,

I have the week number as as string because that's how it's formatted in my MS Access db. It looks something like Format([Dat Entered],"ww") AS WeekNum in my Query. There are just a few weeks that aren't getting into my pivot table for selection. I guess my next step is to go to those weeks and see what is different. If you can think of any reasons plz let me know!! Thanks Again

 

[Call_Me_Sam]

Thx for the reply Call_Me_Sam,

I have the week number as as string because that's how it's formatted in my MS Access db. It looks something like Format([Dat Entered],"ww") AS WeekNum in my Query. There are just a few weeks that aren't getting into my pivot table for selection. I guess my next step is to go to those weeks and see what is different. If you can think of any reasons plz let me know!! Thanks Again

i still think it's something to do with the data type...just can't replicate it at moment..but it does beg the question, why store a number as text?

 

[greenguy]

Hey Call_Me_Sam thx again for the reply! I have solved my problem by creating a query of the query and it works great! As far as the data type being a string an not numeric. That's the way Access was handling the Week Number. Since I'm not doing any math with the week number it's all good. Thanks again for the reply and if you have any other concerns let me know. Below is the code I used to get the information needed.


Sub FourWeekData(strweeknum, intweek, stryear)
Dim wk1
Dim wk2
Dim wk3
Dim wk4
Dim struser As String

Unload frmdefects
Application.ScreenUpdating = False
Sheets("Data").Select
Cells.Clear
intweek = CInt(strweeknum)
wk4 = intweek
wk3 = intweek - 1
wk2 = intweek - 2
wk1 = intweek - 3

wk4 = CStr(wk4)
wk3 = CStr(wk3)
wk2 = CStr(wk2)
wk1 = CStr(wk1)

On Error GoTo ErrExit
struser = Environ("USERNAME")
Sheets("Data").Activate

With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
.Connection = Array(Array( _
"ODBC;DSN=DesktopMach;DBQ=C:\Documents and Settings\" & struser & "\Desktop\LWCMachining.mdb;DriverId=25;FIL=MS Access;MaxBufferSize=2048;Pag" _
), Array("eTimeout=5;"))
.CommandType = xlCmdSql
.CommandText = Array( _
"SELECT QRYxlqualreport.Area, QRYxlqualreport.Shift, QRYxlqualreport.Category, QRYxlqualreport.Reason, QRYxlqualreport.Qty, QRYxlqualreport.`Week Number`, QRYxlqualreport.`Year Entered`" & Chr(13) & "" & Chr(10) & "FROM `C:\Docum" _
, _
"ents and Settings\" & struser & "\Desktop\LWCMachining`.QRYxlqualreport QRYxlqualreport" & Chr(13) & "" & Chr(10) & "WHERE (QRYxlqualreport.`Week Number`='" & wk1 & "') AND (QRYxlqualreport.`Year Entered`='" & stryear & "') OR (QRYxlqualreport.`Week Number`=" _
, _
"'" & wk2 & "') AND (QRYxlqualreport.`Year Entered`='" & stryear & "') OR (QRYxlqualreport.`Week Number`='" & wk3 & "') AND (QRYxlqualreport.`Year Entered`='" & stryear & "') OR (QRYxlqualreport.`Week Number`='" & wk4 & "') AND (QRYxlqualreport.`Year Ent" _
, "ered`='" & stryear & "')")
.CreatePivotTable TableDestination:="[4RobBergmann.xls]Data!R3C1", _
TableName:="PivotTable4", DefaultVersion:=xlPivotTableVersion10
End With
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Area")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Shift")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Week Number")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Category")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Reason")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("Qty"), "Sum of Qty", xlSum
ActiveWorkbook.ShowPivotTableFieldList = False


Call MakeChart 'Module 4
Sheets("Data").Select
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
Exit Sub
ErrExit:
MsgBox "There was a problem communicating with the database!", vbCritical + vbOKOnly, "Communication Error"
MsgBox Err.Number & vbCrLf & Err.Description
End Sub

 

[Call_Me_Sam]

greenguy, thanks for posting the code... must admit you have given me ideas for creating pivot tables on the fly now, though we are trying to get away from them as they are impractical in some of our reports.. thanks

 

[greenguy]

Call Me Sam,
Not a problem. The only reason I created this was because some individuals at my site have limited knowledge on pivot tables and since the code does everything for them they'll actually use the tool. I've made a few other minor changes to the code like using Thisworkbook.Name for the name of the workbook the user will be using. I did this because some people like to change the name of the workbook after I give it to them.

Later

 

[Call_Me_Sam]

Call Me Sam,
Not a problem. The only reason I created this was because some individuals at my site have limited knowledge on pivot tables and since the code does everything for them they'll actually use the tool. I've made a few other minor changes to the code like using Thisworkbook.Name for the name of the workbook the user will be using. I did this because some people like to change the name of the workbook after I give it to them.

Later

good point about Thisworkbook...though i believe ActiveWorkbook means you don't have to define the name?

 

[greenguy]

True but you'll need ThisWorkBook.Name here

".CreatePivotTable TableDestination:="[4RobBergmann.xls]Data!R3C1", "

 

[shades]

Just as a note on Pivot tables with VBA, chapter 12 of VBA and Macros for MS Excel by Bill Jelen (Mr. Excel), et al, is a superb helper, in which you can create code on the fly (with automatic resizing, etc.). Code samples provided. Once I began using it in VBA I seldom went back to creating PT in Excel itself.
________
List of ceos of ford motor company history

 

[Call_Me_Sam]

Just as a note on Pivot tables with VBA, chapter 12 of VBA and Macros for MS Excel by Bill Jelen (Mr. Excel), et al, is a superb helper, in which you can create code on the fly (with automatic resizing, etc.). Code samples provided. Once I began using it in VBA I seldom went back to creating PT in Excel itself.

shades..i used to look on Mr Excel..cool site...must check it out again.. thanks for the reminder

 

[Call_Me_Sam]

good point about Thisworkbook...though i believe ActiveWorkbook means you don't have to define the name?

foot in mouth time..just found an instant where i did store the workbook name in a variable to be used later... ok it was using Activeworkbook.Name but you get my drift..