VBA queries on Variables, Pivot Table etc.

[minette]

Hi Everyone

I have a few queries on the below code, and thought I'd list them all together. The code is basically designed to run a query in access and paste it to the ‘Template’ workbook. Then create a new workbook, copy three sheets from the ‘Template’ workbook into the new book and close the ‘Template’ file.

I have 'commented' my queries in the code with the numbers 1, 2 and 3.
(1) The first problem is that I am retrieving a dataset from Access. I would like to set some variables (which the user can fill in) to restrict it to a certain data range. I have tried a few things, but nothing worked, so I thought I'd better speak to the experts......
(2) Secondly, on the Copy sheet in the 'template' file, I have formulas copied onto the whole sheet. This is copying certain data from the basedata sheet and formatting it. So, I need to make sure that the formulas on the 'Copy' sheet is always the same as the number of rows returned from the Access query in the 'Basedata' sheet. I have NO IDEA how to do this. Does anyone know what I can do here?
(3) Lastly, when I copy the Pivot sheet to the New Workbook, the pivot table range is still taken from the 'Template' workbook, and not from the new file I've created. Does someone know how you can change the range of the Pivot table in VBA?

Well, that's it for now. Hopefully someone out there will be able to answer these questions, even if you can only answer one or two, I would be eternally grateful.

Many thanks
Minette


Sub test1()
'(1) Retrieve data from Access
Dim ThePath As String
ThePath = "C:\MINETTE\Excel Macros etc\Noida WB\"
Dim Db As DAO.Database
Dim Rs As DAO.Recordset
Dim ws As Worksheet, i As Integer
Set ws = ThisWorkbook.Sheets("basedata")
Set Db = OpenDatabase("C:\MINETTE\Excel Macros etc\Noida WB\WORKbasket.mdb", False, True)
Set Rs = Db.OpenRecordset("Noida_with _pol_nos", dbOpenSnapshot)
With ws
For i = 1 To Rs.Fields.Count
.Cells(1, i) = Rs.Fields(i - 1).Name
Next i
.Range("A2").CopyFromRecordset Rs
End With
Db.Close
Set Rs = Nothing
Set Db = Nothing
Sheets("basedata").Select
'Remove all spaces from Column A and C
Range("A:A,O:O").Select
Application.DisplayAlerts = False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.DisplayAlerts = True
'(2) Ensure the rows on the Copy sheet is the same as the query data on the Basedata sheet
Range("P1").Select
Dim Count As Range
'Count = ActiveCell.FormulaR1C1 = "=COUNTA(C[-15])"

'Create a blank workbook
Workbooks.Add
Application.DisplayAlerts = False
'Create a name for the new workbook
ActiveWorkbook.SaveAs Filename:=ThePath & "Noida WB Pol No " & Format(Now, "yyyy-mm-dd") & ".xls"
'Copy the Context sheet to the new workbook.
Windows("Noida Pol No Template.xls").Activate
Sheets("Context").Copy Before:=Workbooks("Noida WB Pol No " & Format(Now, "yyyy-mm-dd") & ".xls").Sheets(1)

'Copy the Finance sheet to the New Workbook
Windows("Noida Pol No Template.xls").Activate
Sheets("Copy").Copy Before:=Workbooks("Noida WB Pol No " & Format(Now, "yyyy-mm-dd") & ".xls").Sheets(2)
Windows("Noida WB Pol No " & Format(Now, "yyyy-mm-dd") & ".xls").Activate
Sheets("copy").Select
Sheets("copy").Name = "List"
Range("D40").Select
'(3) Copy the Pivot sheet to the New Workbook
Windows("Noida Pol No Template.xls").Activate
Sheets("Pivot").Copy Before:=Workbooks("Noida WB Pol No " & Format(Now, "yyyy-mm-dd") & ".xls").Sheets(3)
Sheets("sheet1").Select

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"List!R6C2:R65536C8").CreatePivotTable TableDestination:= _
"'[Noida WB Pol No 2006-10-20.xls]Sheet1'!R3C1", TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
Range("A7").Select

'Remove sheet1, sheet2, sheet3
'Windows("Noida Pol No Template.xls").Activate
'Range("F12").Select
Windows("Noida WB Pol No " & Format(Now, "yyyy-mm-dd") & ".xls").Activate
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
ActiveWindow.SelectedSheets.Delete
Range("I23").Select
Windows("Noida Pol No Template.xls").Activate
Application.DisplayAlerts = True
ActiveWorkbook.Save
Windows("Noida WB Pol No " & Format(Now, "yyyy-mm-dd") & ".xls").Activate
Sheets("context").Select
'Save As Noida Pol No yyyy-mm-dd in the following folder "C:\MINETTE\Finance\Noida WB
ActiveWorkbook.Save
MsgBox "The macro has finished and will now close the template file"
Windows("Noida Pol No Template.xls").Activate
'Save and close the Noida Pol No Template file
ActiveWorkbook.Close
End Sub

 

[minette]

Does anyone have any ideas on the questions below please?

 

[minette]

Hi everyone

I've not had a reply on this post yet, and was wondering if there's anyone out there who might be able to help with this.

Thanks
Minette

 

[minette]

Any ideas guys? I don't think it should be too difficult to do, but I just can't seem to figure these out.

Thanks
Minette

 

[Ahnold]

Just a place to start

Minette,

This will need some adjusting, but hopefully should be a start. Give it a go and post back with any questions or problems.

Sub test1()
    'Make reference to Microsoft ActiveX Data Objects 2.8 Library
    Dim Conn As ADODB.Connection
    Dim RS As ADODB.Recordset
    Dim TempWB As Workbook
    Dim NewWB As Workbook
    Dim WS As Worksheet
    Dim i As Integer
    Dim lngCount As Long
    Dim strSQL As String
    Dim strCriteria As String
    Const ThePath As String = "C:\MINETTE\Excel Macros etc\Noida WB\"
    
    Set Conn = New ADODB.Connection
    Set RS = New ADODB.Recordset
    Set TempWB = ThisWorkbook
    Set WS = TempWB.Sheets("basedata")
    'This is where you retieve you data filter information.
    strCriteria = InputBox("Enter criteria!")
    
    Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThePath & "WORKbasket.mdb;"
    'Change Field1 to the actual field name that you need to filter.
    strSQL = "SELECT * FROM Noida_with_pol_nos" _
        & " WHERE Field1='" & strCriteria & "'"
    RS.Open strSQL, Conn
    'This will return the count of records in the dataset.
    lngCount = RS.RecordCount
    
    With WS
        For i = 1 To RS.Fields.Count
            .Cells(1, i) = RS.Fields(i - 1).Name
        Next i
        .Range("A2").CopyFromRecordset RS
        .Range("A:A,O:O").Replace What:=" ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    End With
    RS.Close
    Set RS = Nothing
    Set NewWB = Workbooks.Add
    TempWB.Sheets("Context").Copy Before:=NewWB.Sheets(1)
    TempWB.Sheets("Copy").Copy Before:=NewWB.Sheets(1)
    NewWB.Sheets("Copy").Name = "List"
    TempWB.Sheets("Pivot").Copy Before:=NewWB.Sheets(1)
    NewWB.SaveAs Filename:=ThePath & "Noida WB Pol No " & Format(Date, "yyyy-mm-dd") & ".xls"
    
    NewWB.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "'[" & NewWB.Name & "]List!R6C2:R65536C8").CreatePivotTable TableDestination:= _
        "'[" & NewWB.Name & "]Pivot'!R3C1", TableName:="PivotTable1", _
        DefaultVersion:=xlPivotTableVersion10
    Application.DisplayAlerts = False
    NewWB.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
    Application.DisplayAlerts = True
    NewWB.Save
    MsgBox "The macro has finished and will now close the template file"
    TempWB.Close
End Sub

 

[minette]

Hi Ahnold

Sorry for only replying now, but I had to try it out first. Thanks so much for looking at my code. It is fantastic. You've reduced it dramatically, and it looks so much better. As you can see, I am a complete novice. However, I now get the following message:-

Run-time error '-2147467259 (80004005)
ODBC--connection to 'DB2E Query' failed


Could it be because I do not have the Microsoft ActiveX Data Objects 2.8 Library. The latest one I have is 2.7 which I used.

Again, your help would be greatly appreciated.
Thanks
Minette