query's sql statement

[jasn_78]

ok guys im not sure if i should be posting this here or under queries so apologies in advance.

i have a query that stores a series of days and values for those days that exports to excel as a graph and works well the only thing i would like to be able do is in some cells under the graph list what each of those periods are e.g date range and other options that was selected for that period.

what is the best way of doing this?

 

[jasn_78]

ok guys i have it now set that i create a query for each period which stores the values i need.

i was thinking the below code to send it to excel

            cell = 22
            p = 1
            Do Until p = 10
                For Each qdf In db.QueryDefs
                If qdf.Name = "qryPERIOD" & p Then
                .range("A" & cell).select
                .activecell.VALUE = "PERIOD " & p
                End If
                Next
            p = p + 1
            cell = cell + 1
            Loop

but it doesnt work
i get the error
object variable or with block variable not set.

any suggestions?

 

[MarkK]

.activecell.VALUE = "PERIOD " & p

It's not clear what object .activecell is a member of. This syntax can only be used inside a With block.
I believe you'll also receive this error if you attempt an object assignment without using the word 'Set', or if you reference a member of an object when the object evaluates to 'Nothing'

 

[boblarson]

What is the rest of your code? And which line gets the error?

 

[jasn_78]

ok sorry bout that one guys i have it almost done just the only thing i am getting is the first column in the query when i want all values returned

the code is as follows

            cell = 22
            p = 1
            Do Until p = 10
            Set qdf = New ADODB.Recordset
            Set qdf.ActiveConnection = CurrentProject.Connection
                sqlp = "SELECT * FROM qryPERIOD" & p
                qdf.Open sqlp
                .range("A" & cell).select
                .activecell.VALUE = qdf.GetRows
            p = p + 1
            cell = cell + 1
            Loop

 

[boblarson]

1. That is not the full code. (I can tell because there is no WITH statement and you have .range and .activecell which means that there is a WITH somewhere).

2. When opening an ADO recordset you don't have to use so much code. You can just use:

Dim rst As ADODB.Recordset

Set rst = New ADODB.Recordset

rst.Open sqlp, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly

Check out my export code here for sending to Excel (I use a DAO recordset in this sample):
http://www.btabdevelopment.com/main/CodeSnippets/tabid/104/Default.aspx
it might help you better.

 

[jasn_78]

Public Function excelquery(strsql As String, period As String, rptval As Integer)

On Error GoTo excel_error

Dim gobjExcel As Object
Dim objws As Object
Dim rng As Object
Dim con As ADODB.Connection
Dim rstdata As ADODB.Recordset
Dim rstcount As ADODB.Recordset
Dim fld As ADODB.field
Dim introwcount As Integer
Dim intcolcount As Integer
Dim numberformat As String
Dim valuetitle As String
Dim cell As Integer
Dim p As Integer
Dim qdf As ADODB.Recordset
Dim sqlp As String

Set gobjExcel = CreateObject("Excel.Application")

DoCmd.Hourglass True

On Error GoTo excel2_error

Set con = Application.CurrentProject.Connection
Set rstdata = New ADODB.Recordset
Set rstdata.ActiveConnection = CurrentProject.Connection

Set rstcount = New ADODB.Recordset
Set rstcount.ActiveConnection = CurrentProject.Connection

On Error GoTo excel3_error

If rptval = 2 Then
    numberformat = ""
    valuetitle = "QUANTITY"
Else
    numberformat = "$#,##0.00"
    valuetitle = "$ AMOUNT"
End If

If CreateRecordset(rstdata, rstcount, strsql, period) = True Then

    If CreateExcelObj() Then
    With gobjExcel
        .Workbooks.Add
        .Application.DisplayAlerts = False
        
        Set objws = .activesheet
        introwcount = 1
        intcolcount = 1
        
        For Each fld In rstdata.Fields
            If fld.Type <> adLongVarBinary Then
                objws.cells(1, intcolcount).VALUE = fld.Name
                intcolcount = intcolcount + 1
            End If
        Next fld
        
        objws.range("A2").CopyFromRecordset rstdata, 500
            .Columns("A:C").select
            .Columns("A:C").EntireColumn.AutoFit
            .range("A1").select
            .activecell.CurrentRegion.select
            Set rng = .Selection
            .Columns("b:c").select
            .Selection.numberformat = numberformat
            .Rows("1:1").select
            .Selection.Font.Bold = True
            With .Selection
                    .HorizontalAlignment = -4108
                    .VerticalAlignment = -4107
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = 1
                    .MergeCells = False
            End With
            .sheets("sheet1").select
            .sheets("sheet1").Name = "SALES FIGURES"
            .sheets("sheet2").select
            .sheets("sheet2").Name = "COMPARISON GRAPH"
            .activesheet.ChartObjects.Add(0, 0, 607.75, 301).select
            .ActiveChart.ChartWizard Source:=.sheets("SALES FIGURES").range(rng.address), _
                gallery:=3, _
                Format:=6, PlotBy:=2, categorylabels:=1, serieslabels _
                :=1, HasLegend:=1, title:="SALES COMPARISON REPORT", categorytitle _
                :=period, valuetitle:=valuetitle, extratitle:=""
            .Visible = True
            .sheets("Sheet3").select
            .ActiveWindow.SelectedSheets.Delete
            .sheets("COMPARISON GRAPH").select
            
            cell = 22
            p = 1
            Do Until p = 3
            Set qdf = New ADODB.Recordset
            Set qdf.ActiveConnection = CurrentProject.Connection
                sqlp = "SELECT * FROM qryPERIOD" & p
                qdf.Open sqlp
                .range("A" & cell).select
                .activecell.VALUE = "PERIOD " & p & qdf.GetRows
            p = p + 1
            cell = cell + 1
            Loop
            
        End With
        Else
        MsgBox "Excel Could not load"
    End If
    Else
    MsgBox "too many records to send"
End If
    
DoCmd.Hourglass False

Set rng = Nothing
Set objws = Nothing
Set gobjExcel = Nothing

excel_exit:
DoCmd.Hourglass False
    Exit Function

excel_error:
    MsgBox "Error " & Err.Number & ": " & Err.DESCRIPTION, , "EXCEL ERROR"
    Resume excel_exit
excel2_error:
    MsgBox "Error " & Err.Number & ": " & Err.DESCRIPTION, , "EXCEL2 ERROR"
    Resume excel_exit
excel3_error:
    MsgBox "Error " & Err.Number & ": " & Err.DESCRIPTION, , "EXCEL3 ERROR"
    Resume excel_exit
End Function

Bob sorry about that i only thought u wanted the whole code for the error i was getting which I have solved.

still looking at ur other suggestions thanks

 

[jasn_78]

Bob that works great except only 2 things
1. how do i get spaces between fields i am returning as the result current looks like this. PERIOD 2BAR 27/01/20087/10/2008

and should look like this. PERIOD 2 BAR 2 01/07/2008 10/07/2008

the other is my code seems to be taking the record from qryPERIOD2 and not also doing period one

what i was trying to do was in cell A22 put in period1's criteria
with the other periods' criterias in the cells below

 

[boblarson]

You might share your revised code so I can make a suggestion. I would assume that you might need to concatenate some spaces in using & " " & somewhere in there.

 

[jasn_78]

yeah sorry bob bit out of it today

            cell = 22
            p = 1
            Do Until p = 3
            Set qdf = New ADODB.Recordset
            Set qdf.ActiveConnection = CurrentProject.Connection
                sqlp = "SELECT * FROM qryPERIOD" & p
                qdf.Open sqlp, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
                .range("A" & cell).select
                .activecell.CurrentRegion.select
                .activecell.VALUE = "PERIOD " & p & qdf.GetString
                qdf.Close
            p = p + 1
            cell = cell + 1
            Loop

that is my code to do with that section that i have revised

the below code is the code on my form that creates the queries i am exporting

Private Sub cmdNEXT_Click()

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim stDocName As String
Dim stLinkCriteria As String
Dim sql As String
Dim valp As String
Dim qtyp As String
Dim DATEFROM As Date
Dim DATETO As Date
Dim sqlstr As String
Dim inttill As Integer
Dim intarea As Integer
Dim strstore As String
Dim fromplu As Integer
Dim toplu As Integer
Dim grpval As Integer
Dim diffval As String
Dim qtyval As String
Dim sqlrange As String
Dim sql2 As String
Dim sqlselect As String
Dim sqlfrom As String
Dim qdp As DAO.QueryDef
Dim length As Integer

On Error GoTo COMPARISON_ERROR

grpval = Me.frmPERIOD.VALUE
rptval = Me.frmREPORTBY.VALUE

Select Case grpval
    Case Is = 1
    period = "DAY"
    diffval = "d"
    Case Is = 2
    period = "WEEK"
    diffval = "w"
    Case Is = 3
    period = "MONTH"
    diffval = "m"
End Select

Select Case Me.frmREPORTBY.VALUE
    Case Is = 1
    qtyval = "HTRX_VALUE"
    Case Is = 2
    qtyval = "HTRX_QTY_1"
    Case Else
    MsgBox "Please choose a Report by Option"
    Exit Sub
End Select

Set db = CurrentDb()

sqlstr = ""

'sets caption on form to period1

p = Right(Forms("frmCOMPARISON").Caption, 1)

' check to see if date from and to entered
' if no date entered exit procedure and focus on date text box
If Nz(Me.txtDATEFROM1, 0) = 0 Then
    MsgBox "YOU MUST CHOOSE A START DATE", , "ENTER A DATE"
    Me.txtDATEFROM1.SetFocus
    Exit Sub
ElseIf Nz(Me.txtDATETO1, 0) = 0 Then
    MsgBox "YOU MUST CHOOSE AN END DATE", , "ENTER A DATE"
    Me.txtDATETO1.SetFocus
    Exit Sub
End If

valp = "PERIOD" & p
DATETO = Me.txtDATETO1
DATEFROM = Me.txtDATEFROM1

'sets the where criteria on the sql command to either store,
'area or till

    If Nz(Me!frmAREAFILTERS.Form.comboTILL, 0) <> 0 Then
        inttill = [Forms]![frmCOMPARISON]![frmAREAFILTERS].[Form]![comboTILL]
        sqlstr = sqlstr & "AND ((HTRXTBL.HTRX_TILL_NUMBER)= " & inttill & ")"
        sqlrange = sqlrange & "((TILLTBL.TILL_NUMBER)= " & inttill & ")"
        sqlselect = sqlselect & "TILLTBL.TILL_DESC, "
        sqlfrom = sqlfrom & "TILLTBL, "
    Else
        If Nz(Me!frmAREAFILTERS.Form.comboAREA, 0) <> 0 Then
            intarea = [Forms]![frmCOMPARISON]![frmAREAFILTERS].[Form]![comboAREA]
            sqlstr = sqlstr & "AND ((HTRXTBL.HTRX_AREA_NUMBER)= " & intarea & ")"
            sqlrange = sqlrange & "((AREATBL.AREA_NUMBER)= " & intarea & ")"
            sqlselect = sqlselect & "AREATBL.AREA_DESC, "
            sqlfrom = sqlfrom & "AREATBL, "
        Else
            If Nz(Me!frmAREAFILTERS.Form.comboSTORE, 0) <> 0 Then
            strstore = [Forms]![frmCOMPARISON]![frmAREAFILTERS].[Form]![comboSTORE]
            sqlstr = sqlstr & "AND ((HTRXTBL.HTRX_SYSC_NUMBER) LIKE " & strstore & ")"
            sqlrange = sqlrange & "((SYSCTBL.SYSC_NUMBER) LIKE " & strstore & ")"
            sqlselect = sqlselect & "SYSCTBL.SYSC_COMPANY, "
            sqlfrom = sqlfrom & "SYSCTBL, "
            End If
        End If
    End If
length = Len(sqlfrom)
sqlfrom = Left(sqlfrom, (length - 2))
sqlfrom = sqlfrom & " "

    If Nz(Me!subfrmPLUFILTERS.Form.txtFROMPLU, 0) <> 0 Then
        fromplu = [Forms]![frmCOMPARISON]![subfrmPLUFILTERS].[Form]![txtFROMPLU]
        sqlstr = sqlstr & " AND ((HTRXTBL.HTRX_ITEM_NUMBER) >= " & fromplu & ")"
        sqlselect = sqlselect & fromplu & " AS FROMPLU, "
    End If
    
    If Nz(Me!subfrmPLUFILTERS.Form.txtTOPLU, 0) <> 0 Then
        toplu = [Forms]![frmCOMPARISON]![subfrmPLUFILTERS].[Form]![txtTOPLU]
        sqlstr = sqlstr & " AND ((HTRXTBL.HTRX_ITEM_NUMBER) <= " & toplu & ")"
        sqlselect = sqlselect & toplu & " AS TOPLU, "
    End If

'creates the sqlcommand for the relevant period and saves to a query

sql = "SELECT " & _
        "(DateDiff('" & diffval & "', " & "CDate('" & DATEFROM & "')" & ",(HTRXTBL.HTRX_TRX_DATE))) AS " & period & " , " & _
        "(Round(Sum(HTRXTBL." & qtyval & "),2)) AS " & valp & " " & _
        "FROM ITEMTBL, HTRXTBL " & _
        "WHERE ITEMTBL.ITEM_NUMBER = HTRXTBL.HTRX_ITEM_NUMBER " & _
        "AND (HTRXTBL.HTRX_REC_TYPE= 'ITMSALE') " & _
        "AND HTRXTBL.HTRX_TRX_DATE BETWEEN CDate('" & DATEFROM & "') AND CDate('" & DATETO & "')" & _
        sqlstr & _
        "GROUP BY " & "((DateDiff('" & diffval & "', " & "CDate('" & DATEFROM & "')" & ",(HTRXTBL.HTRX_TRX_DATE))))"

sqlselect = sqlselect & "#" & Format(DATEFROM, "dd/mm/yyyy") & "#" & " AS FROMDATE, " & "#" & Format(DATETO, "dd/mm/yyyy") & "#" & " AS TODATE "

'MsgBox sqlselect
'MsgBox sqlfrom
'MsgBox sqlrange

sql2 = "SELECT " & _
        sqlselect & _
        "FROM " & _
        sqlfrom & _
        "WHERE " & _
        sqlrange
        
'MsgBox sql2

Set qdf = db.CreateQueryDef("qryCOMPARISON" & p)
Set qdp = db.CreateQueryDef("qryPERIOD" & p)

'Create qrycomparison

qdf.sql = sql
qdp.sql = sql2

p = Right(Forms("frmCOMPARISON").Caption, 1) + 1
  
'RENAME CAPTION OF FORM FOR EACH NEW PERIOD
If p <= 9 Then
    Forms("frmCOMPARISON").Caption = "SALES COMPARISON PERIOD" & p
Else
    MsgBox "You have entered the maximum amount of periods", vbOKOnly
    GoTo COMPARISON_EXIT
End If
  
'Re-open comparison for next period

stDocName = "frmCOMPARISON"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Call reset_filters

COMPARISON_EXIT:
    Exit Sub

COMPARISON_ERROR:
MsgBox "Error " & Err.Number & ": " & Err.DESCRIPTION, , "NEXT PERIOD ERROR"
    Resume COMPARISON_EXIT
    
End Sub

 

[jasn_78]

bob thanks for ur help again with this everything is good now
except my dates are being stored in my query as u.s format even when i format them dd/mm/yyyy

anyway to say force it to say which value is my day month year etc?