Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Help with my list filter to my teradata using Access as front-end

Status
Not open for further replies.

tmcrouse

Programmer
Dec 21, 2011
39
US
I have the following code and it worked when my tables were in Access, however the tables have been migrated to our Teradata server and I ODBC with Access. My tables are now named for example DL_QPT_CQE_Measures. I tried changing my code to DL_QPT_CQE_Measures.hedis_measures, however it does not work. I am not sure how to alter this code to make it work.

Code:
Option Compare Database
Option Explicit
Global GlobalID As Long 'used to hold an ID for a short time (after a record is added)

Public Sub sSortListBox(anyListbox As Control, Button As Integer, Shift As Integer, X As Single)

Dim strSql As String
Dim vGetWidths As Variant
Dim vArWidths() As Variant
Dim iColCount As Integer, iColNumber As Integer
Dim iLoop As Integer
Dim iColWidthSum As Integer
Dim iUndefined As Integer
Dim iDefaultWidth As Integer
Dim strOrderBy As String
Const strListSeparator As String = ";" 'list Separator
'If your list separator is not a ";"
'you will need to change the ";" to your list separator

    On Error GoTo ERROR_sSortListBox

    If Button <> acRightButton Then
       'only sort based on right button being clicked

    ElseIf anyListbox.RowSourceType <> "table/query" Then
       'only sort listbox based on queries
       msgbox "List box must use a query as it's row source"

    ElseIf Len(anyListbox.RowSource) = 0 Then
       'Nothing there, so ignore the click

    ElseIf Not (InStr(1, Trim(anyListbox.RowSource), "Select", vbTextCompare) = 1 _
       Or InStr(1, Trim(anyListbox.RowSource), "Parameters", vbTextCompare) = 1) Then
       'If rowsource does not start with SELECT or PARAMETERS then
       'assume it is a table not a query
       msgbox "List box must use a query as its row source"

    ElseIf anyListbox.ColumnCount <> DBEngine(0)(0).CreateQueryDef("", anyListbox.RowSource).Fields.Count Then
       'Column count must be correctly set, otherwise this routine
       'could cause errors. Column count set less than actual field count
       'will cause subscript errors.  Column count set higher than actual
       'field count can cause listbox to display nothing if "Extra" column
       'is clicked.
       msgbox "List box column count does not match query field count!"

    Else   'passed the error checks

       With anyListbox
          'Column count must be correctly set, otherwise this routine
          'could cause errors. Column count set less than actual column Count
          'will cause subscript errors.  Column count set higher than actual
          'column count can cause listbox to display nothing if "Extra" Column
          'is clicked.
          iColCount = .ColumnCount
          ReDim vArWidths(iColCount - 1, 0 To 1)

          vGetWidths = Split(.ColumnWidths, strListSeparator, -1, vbTextCompare)

          'Assign values to array that holds length and running sum of Length
          For iLoop = 0 To UBound(vGetWidths)
             iColWidthSum = iColWidthSum + Val(vGetWidths(iLoop))
             vArWidths(iLoop, 1) = iColWidthSum
             vArWidths(iLoop, 0) = vGetWidths(iLoop)
          Next iLoop

          'Adjust any colwidths that are unspecified:
          'The minimum is the larger of 1440
          'or the remaining available width of the list box
          'divided by number of columns
          'with unspecified lengths.
          For iLoop = 0 To iColCount - 1
             If Len(vArWidths(iLoop, 0) & vbNullString) = 0 Then
                iUndefined = iUndefined + 1
             End If
          Next iLoop

          If iUndefined <> 0 Then
             iDefaultWidth = (.Width - iColWidthSum) / iUndefined
          End If

          If iDefaultWidth > 0 And iDefaultWidth < 1440 Then
             msgbox "Sorry! Can't process listboxes with horizontal ScrollBars "
             Exit Sub  'Horizontal scroll bar present
          Else
             'recalculate widths and running sum of column widths
             iColWidthSum = 0
             For iLoop = 0 To iColCount - 1
                If Len(vArWidths(iLoop, 0) & vbNullString) = 0 Then
                   vArWidths(iLoop, 0) = iDefaultWidth
                End If
                iColWidthSum = iColWidthSum + Val(vArWidths(iLoop, 0))
                vArWidths(iLoop, 1) = iColWidthSum

             Next iLoop
          End If

          'Set right edge of last column equal to width of listbox
          vArWidths(iColCount - 1, 1) = .Width

          'Determine which column was clicked
          For iLoop = 0 To iColCount - 1
             'If X - .Left <= vArWidths(iLoop, 1) Then
             If X <= vArWidths(iLoop, 1) Then
                iColNumber = iLoop
                Exit For
             End If
          Next iLoop
          iColNumber = iColNumber + 1   'adjust since iLoop is 0 to n-1

          'rebuild sql statement
          If iColNumber > 0 And iColNumber <= iColCount Then
             strSql = Trim(.RowSource)

             If Right(strSql, 1) = ";" Then strSql = Left(strSql, Len(strSql) - 1)

             iLoop = InStr(1, strSql, "Order by", vbTextCompare)
             If iLoop > 0 Then
                strOrderBy = Trim(Mid(strSql, iLoop + Len("Order by")))
                strSql = Trim(Left(strSql, iLoop - 1))
             End If

             'Build the appropriate ORDER BY clause
             If Shift = acShiftMask Then
             'If shift key is down force sort to desc on selected column
                strOrderBy = " Order By " & iColNumber & " Desc"

             ElseIf Len(strOrderBy) = 0 Then
             'If no prior sort then sort this column ascending
                strOrderBy = " Order by " & iColNumber & " Asc"

             ElseIf InStr(1, strOrderBy, iColNumber & " Asc", vbTextCompare) > 0 Then
             'If already sorted asc on this column then sort descending
                strOrderBy = " Order By " & iColNumber & " Desc"

             ElseIf InStr(1, strOrderBy, iColNumber & " Desc", vbTextCompare) > 0 Then
             'If already sorted desc on this column then sort Ascending
                strOrderBy = " Order By " & iColNumber & " Asc"

             Else
                 strOrderBy = " Order by " & iColNumber & " Asc"
             End If

             strSql = strSql & strOrderBy
             .RowSource = strSql

          End If   'Rebuild SQL if col number is in range 1 to number of columns
       End With 'current list
    End If  'Passed error checks

EXIT_sSortListBox:
    Exit Sub

ERROR_sSortListBox:
    Select Case Err.Number
       Case 9  'Subscript out of range
          msgbox Err.Number & ": " & Err.Description & _
                 vbCrLf & vbCrLf & "Check column count property of list box.", _
                 vbInformation, "ERROR: sSortListBox"

       Case Else 'unexpected error
          msgbox Err.Number & ": " & Err.Description, vbInformation, _
                 "ERROR: sSortListBox"
    End Select

    Resume EXIT_sSortListBox
End Sub

Public Function BuildFilteredSQL(filtertext As String, filterType As String, sqltext As String) As String
On Error GoTo Err_BuildFilteredSQL
'Builds a sql statement using the filtertext, filtertype and sqltext
'The filtertext is the string to filter on
'The filterType determines what fields are used to do the filtering on
'Note: these are hardcoded in this routine
'the sqltext determines the base sql query to modify

    Dim sql As String
    Dim fff As Integer
    Dim sqlwhere As String
    Dim doneFlag As Integer
        
    sql = sqltext
    'good for debugging
    'MsgBox sql & "||"
    
    'take off extra spaces and ";" if they exist
    sql = RTrim(sql)
    If (Right(sql, 1) = ";") Then
        sql = Left(sql, Len(sql) - 1)
    End If
    
    'Build a new WHERE clause based on passed in parameters
    If (filtertext <> "") And (filterType <> "") Then
        Select Case filterType
            Case "Quality"
'*****This is where the Select is located to find things easily********
                sqlwhere = "WHERE ((MEASURES.HEDIS_MEASURE Like '*" & filtertext & "*') OR (PROGRAM.Prog_NM Like '*" & filtertext & "*') OR (CONTACTS.ContacT Like '*" & filtertext & "*') OR (MEASURES.CONDITION_CATEGORY LIKE '*" & filtertext & "*') OR (COMMUNICATION.Comm_type Like '*" & filtertext & "*') OR (BUS_UNIT.bus_unit Like '*" & filtertext & "*') OR (LOB.lob Like '*" & filtertext & "*') OR (PRODUCT.prod_nm Like '*" & filtertext & "*') OR (COMM_LVL.comm_lvl Like '*" & filtertext & "*')OR (STATE.stcd Like '*" & filtertext & "*')OR (COMM_LVL.comm_lvl Like '*" & filtertext & "*') OR (YEAR_TABLE.yr Like '*" & filtertext & "*')OR (MONTH_TABLE.mth Like '*" & filtertext & "*') or (funding.fund_cd line '*" & filtertest & "*'))"
           Case "Resource"
                sqlwhere = "WHERE ((tblResource.hedis_measure Like '*" & filtertext & "*') OR (tblResource.prog_nm Like '*" & filtertext & "*') OR (tblResource.contacT Like '*" & filtertext & "*') OR (TBLRESOURCE.CONDITION_CATEGORY LIKE '*" & filtertext & "*') OR (tblResource.comm_type Like '*" & filtertext & "*') OR (tblResource.bus_unit Like '*" & filtertext & "*') OR (tblResource.lob Like '*" & filtertext & "*') OR (tblResource.prod_nm Like '*" & filtertext & "*') OR (tblResource.comm_lvl Like '*" & filtertext & "*') OR (tblResource.stcd Like '*" & filtertext & "*') OR (tblResource.comm_lvl Like '*" & filtertext & "*')OR  (tblResource.yr Like '*" & filtertext & "*')OR (tblResource.mth Like '*" & filtertext & "*') or (tblResource.fund_cd like '*" & filtertext & "*'))"
        End Select
    End If
            
    'modify existing HAVING or WHERE clauses (modifies having if sqlwhere starts with "HAVING")
    doneFlag = 0
    'look for GROUP BY clause (if so use HAVING instead of WHERE)
    fff = InStr(1, sqlwhere, "HAVING")
    If (fff <> 0) Then
        'look for existing HAVING clause in sql
        fff = InStr(1, sql, "HAVING ")
        If (fff <> 0) Then ' found a HAVING clause
            'Merge in new criteria into HAVING clause
            sql = Left(sql, fff - 1) & sqlwhere & " AND " & Right(sql, Len(sql) - fff - 6)
            doneFlag = 1
        End If
    Else
        'look for existing WHERE clause
        fff = InStr(1, sql, "WHERE ")
        If (fff <> 0) Then ' found a WHERE clause
            'Merge in new criteria into WHERE clause
            sql = Left(sql, fff - 1) & sqlwhere & " AND " & Right(sql, Len(sql) - fff - 5)
            doneFlag = 1
        End If
    End If
           
    'no HAVING or WHERE clause so add a new one (either before ORDER BY or at end of sql)
    'Note:routine needs to be modified to work with filtering sql on the where clause when the sql has both where and having clauses
    If (doneFlag = 0) Then
        fff = InStr(1, sql, "ORDER BY")
        If (fff <> 0) Then 'found an ORDER BY clause
            sql = Left(sql, fff - 1) & sqlwhere & Right(sql, Len(sql) - fff + 1)
        Else
            sql = sql & " " & sqlwhere
        End If
    End If
        
' good for debugging
'MsgBox sql
    BuildFilteredSQL = sql
   
Exit_BuildFilteredSQL:
    Exit Function

Err_BuildFilteredSQL:
    msgbox Err.Description
    Resume Exit_BuildFilteredSQL

End Function

Public Function GetFilterFromListBoxes() As String
  Dim lst As Access.ListBox
  Dim ctrl As Access.Control
  Dim fieldName As String
  Dim fieldType As String
  Dim TotalFilter As String
  Dim ListFilter As String
  Dim itm As Variant
  'Each listbox needs a tag property with the  field name and the field type
  'Seperate these with a ;
  'The types are Text, Numeric, or Date
  For Each ctrl In Me.Controls
     If ctrl.ControlType = acListBox Then
       fieldName = Split(ctrl.tag, ";")(0)
       fieldType = Split(ctrl.tag, ";")(1)
       For Each itm In ctrl.ItemsSelected
       If ListFilter = "" Then
         ListFilter = GetProperType(ctrl.ItemData(itm), fieldType)
       Else
         ListFilter = ListFilter & "," & GetProperType(ctrl.ItemData(itm), fieldType)
       End If
       Next itm
       If Not ListFilter = "" Then
          ListFilter = fieldName & " IN (" & ListFilter & ")"
       End If
       If TotalFilter = "" And ListFilter <> "" Then
         TotalFilter = ListFilter
       ElseIf TotalFilter <> "" And ListFilter <> "" Then
         TotalFilter = TotalFilter & " AND " & ListFilter
       End If
       ListFilter = ""
     End If
  Next ctrl
  GetFilterFromListBoxes = TotalFilter
End Function

Public Function GetProperType(varitem As Variant, fieldType As String) As Variant
  If fieldType = "Text" Then
    GetProperType = sqlTxt(varitem)
  ElseIf fieldType = "Date" Then
    GetProperType = SQLDate(varitem)
  Else
    GetProperType = varitem
  End If
End Function

Public Function sqlTxt(varitem As Variant) As Variant
  If Not IsNull(varitem) Then
    varitem = Replace(varitem, "'", "''")
    sqlTxt = "'" & varitem & "'"
  End If
End Function

Function SQLDate(varDate As Variant) As Variant
     If IsDate(varDate) Then
        If DateValue(varDate) = varDate Then
            SQLDate = Format$(varDate, "\#mm\/dd\/yyyy\#")
        Else
            SQLDate = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
        End If
    End If
End Function
 
it does not work" is not a description of a problem.
Do you get an error? If so, what error and on which line of code?

You mentioned DL_QPT_CQE_Measures table, but there is no such table in the code you provided...

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.
 
Thanks. I had it wrong in the code. I was doing it like this: [dl_qpt_cqe].[measures].[hedis_measure] and all the other tables. I had to change it to:

dl_qpt_cqe_measures.hedis_measure, etc. It works now. Thanks
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top