Results 1 to 8 of 8
  1. #1
    Join Date
    Jan 2011
    Location
    Grand Haven / Royal Oak Michigan USA
    Posts
    23

    Unanswered: InStr Comparison

    I was thinking 'If InStr(strTypes, strStats) Then' was going to make a comparison of any piece of strTypes against strStats but that is not the case is it? Any suggestions on how to loop through what I have collected in strTypes then loop through to compare against strStats???

    Private Sub AlertTypeID_AfterUpdate()
    '************************************************* ********
    '* MOD RAL 12/08/2011 Code To Compare Status Types *
    '************************************************* ********
    If Me.AlertTypeID.Column(0) = 4 Then
    Dim strPrj, strType, strSQL, strTypes, strStats As String
    Dim rstType, rstStat As Recordset
    Stop
    strPrj = Me!ProjectID

    strSQL = "SELECT [tblIBMCSR].[Field60] "
    strSQL = strSQL & "FROM [tblIBMCSR] "
    strSQL = strSQL & "WHERE [tblIBMCSR].[Field5]= '" & strPrj & "'"

    Set rstType = CurrentDb.OpenRecordset(strSQL)

    strTypes = ""
    If rstType.RecordCount > 0 Then
    rstType.MoveFirst
    While Not rstType.EOF
    If strTypes = "" Then
    strTypes = ""
    Else
    strTypes = strTypes & ", "
    End If
    strTypes = strTypes & IIf(IsNull(rstType(0).Value), "", rstType(0).Value)
    rstType.MoveNext
    Wend
    End If
    rstType.Close

    strSQL = "SELECT DISTINCT [tblIBMCSRStatus].[StatusCode] "
    strSQL = strSQL & "FROM [tblIBMCSRStatus] "
    strSQL = strSQL & "WHERE (((tblIBMCSRStatus.StatusCode)<>'CANC')) AND (((tblIBMCSRStatus.StatusCode)<>'COMP'))"

    Set rstStat = CurrentDb.OpenRecordset(strSQL)

    strStats = ""
    If rstStat.RecordCount > 0 Then
    rstStat.MoveFirst
    While Not rstStat.EOF
    If strStats = "" Then
    strStats = ""
    Else
    strStats = strStats & ", "
    End If
    strStats = strStats & IIf(IsNull(rstStat(0).Value), "", rstStat(0).Value)
    rstStat.MoveNext
    Wend
    End If
    rstStat.Close

    If InStr(strTypes, strStats) Then
    DoCmd.Beep
    MsgBox "Status Information - Communication Type.", vbCritical, "Outstanding CSR Status Prevents This Action..."
    Set Me!AlertTypeID.Column(0) = 2
    Me!AlertTypeID.SetFocus
    Else
    Exit Sub
    End If
    Else
    Exit Sub
    End If
    End Sub

    My Best ~ Rob
    Rbert

  2. #2
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    InStr Function (from MSDN)
    --------------

    Description: Returns an integer specifying the start position of the first occurrence of one
    ----------- string within another string.
    Syntax: x = Instr([Start], String1, String2, [Compare])
    -------
    Parameters:
    -----------
    Start: Optional. Numeric expression that sets the starting position for each search. If
    omitted, search begins at the first character position. The start index is 1-based.

    String1: Required. String expression being searched.

    String2: Required. String expression sought.

    Compare: Optional. Specifies the type of string comparison.
    --------- If Compare is omitted, the Option Compare setting determines the type of comparison.

    In you code, you concatenate what is grabbed from the leftmost field of the recordsets (whatever it can be) with a comma separator to assemble the strTypes and strStats variables.

    1. This:
    Code:
    Dim strPrj, strType, strSQL, strTypes, strStats As String
    creates four (4) variant variables: strPrj, strType, strSQL and strTypes and one (1) string variable: strStats.

    2. This:
    Code:
    strTypes = strTypes & IIf(IsNull(rstType(0).Value), "", rstType(0).Value)
    can be simply written:
    Code:
    strTypes = strTypes & Nz(rstType(0).Value, "")
    3. This:
    Code:
    If InStr(strTypes, strStats) Then
    returns zero (0) if strStats cannot be found in (i.e. is not part of) strTypes.
    returns the first position found for strStats in strTypes otherwise.

    If for a reason I don't understand, you cannot perform the comparison while looping into the recordsets (which would probably be the most efficient way), you can:

    1. Store the values fetched from the recordsets into two arrays, then compare each element of both arrays in a loop,
    or
    2. Create two arrays from StrTypes and strStats, using the Split() function, then perform the comparison of the elements of both arrays in a loop. This is obviously the least efficient method, but also the one that would require the less changes in your code.
    Have a nice day!

  3. #3
    Join Date
    Jan 2011
    Location
    Grand Haven / Royal Oak Michigan USA
    Posts
    23
    I will try my hand at developing code for storing the values fetched from the record-sets into two arrays, then comparing each element of both arrays in a loop. THANKS
    Rbert

  4. #4
    Join Date
    Jan 2011
    Location
    Grand Haven / Royal Oak Michigan USA
    Posts
    23
    This should be a great template to work with:

    Public Function CompareArrays(Array1 As Variant, Array2 As Variant, _
    ResultArray As Variant, Optional CompareMode As VbCompareMethod = vbTextCompare) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' '''
    ' CompareArrays
    ' This function compares two arrays, Array1 and Array2, element by element, and puts the results of
    ' the comparisons in ResultArray. Each element of ResultArray will be -1, 0, or +1. A -1 indicates that
    ' the element in Array1 was less than the corresponding element in Array2. A 0 indicates that the
    ' elements are equal, and +1 indicates that the element in Array1 is greater than Array2. Both
    ' Array1 and Array2 must be allocated single-dimensional arrays, and ResultArray must be dynamic array
    ' of a numeric data type (typically Longs). Array1 and Array2 must contain the same number of elements,
    ' and have the same lower bound. The LBound of ResultArray will be the same as the data arrays.
    '
    ' An error will occur if Array1 or Array2 contains an Object or User Defined Type.
    '
    ' When comparing elements, the procedure does the following:
    ' If both elements are numeric data types, they are compared arithmetically.

    ' If one element is a numeric data type and the other is a string and that string is numeric,
    ' then both elements are converted to Doubles and compared arithmetically. If the string is not
    ' numeric, both elements are converted to strings and compared using StrComp, with the
    ' compare mode set by CompareMode.
    '
    ' If both elements are numeric strings, they are converted to Doubles and compared arithmetically.
    '
    ' If either element is not a numeric string, the elements are converted and compared with StrComp.
    '
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' ''''

    Dim Ndx1 As Long
    Dim Ndx2 As Long
    Dim ResNdx As Long
    Dim S1 As String
    Dim S2 As String
    Dim D1 As Double
    Dim D2 As Double
    Dim Done As Boolean
    Dim Compare As VbCompareMethod
    Dim LB As Long

    ''''''''''''''''''''''''''''''''''''
    ' Set the default return value.
    ''''''''''''''''''''''''''''''''''''
    CompareArrays = False

    ''''''''''''''''''''''''''''''''''''
    ' Ensure we have a Compare mode
    ' value.
    ''''''''''''''''''''''''''''''''''''
    If CompareMode = vbBinaryCompare Then
    Compare = vbBinaryCompare
    Else
    Compare = vbTextCompare
    End If


    ''''''''''''''''''''''''''''''''''''
    ' Ensure we have arrays.
    ''''''''''''''''''''''''''''''''''''
    If IsArray(Array1) = False Then
    Exit Function
    End If
    If IsArray(Array2) = False Then
    Exit Function
    End If
    If IsArray(ResultArray) = False Then
    Exit Function
    End If

    '''''''''''''''''''''''''''''''''''
    ' Ensure ResultArray is dynamic
    '''''''''''''''''''''''''''''''''''
    If IsArrayDynamic(Arr:=ResultArray) = False Then
    Exit Function
    End If

    ''''''''''''''''''''''''''''''''''''''''''
    ' Ensure the arrays are single-dimensional.
    ''''''''''''''''''''''''''''''''''''''''''
    If NumberOfArrayDimensions(Arr:=Array1) <> 1 Then
    Exit Function
    End If
    If NumberOfArrayDimensions(Arr:=Array2) <> 1 Then
    Exit Function
    End If
    If NumberOfArrayDimensions(Arr:=Array1) > 1 Then 'allow 0 indicating non-allocated array
    Exit Function
    End If

    ''''''''''''''''''''''''''''''''''''''''''
    ' Ensure the LBounds are the same
    ''''''''''''''''''''''''''''''''''''''''''
    If LBound(Array1) <> LBound(Array2) Then
    Exit Function
    End If


    ''''''''''''''''''''''''''''''''''''''''''
    ' Ensure the arrays are the same size.
    ''''''''''''''''''''''''''''''''''''''''''
    If (UBound(Array1) - LBound(Array1)) <> (UBound(Array2) - LBound(Array2)) Then
    Exit Function
    End If

    ''''''''''''''''''''''''''''''''''''''''''''''
    ' Redim ResultArray to the numbr of elements
    ' in Array1.
    ''''''''''''''''''''''''''''''''''''''''''''''
    ReDim ResultArray(LBound(Array1) To UBound(Array1))

    Ndx1 = LBound(Array1)
    Ndx2 = LBound(Array2)

    ''''''''''''''''''''''''''''''''''''''''''''''
    ' Scan each array to see if it contains objects
    ' or User-Defined Types. If found, exit with
    ' False.
    ''''''''''''''''''''''''''''''''''''''''''''''
    For Ndx1 = LBound(Array1) To UBound(Array1)
    If IsObject(Array1(Ndx1)) = True Then
    Exit Function
    End If
    If VarType(Array1(Ndx1)) >= vbArray Then
    Exit Function
    End If
    If VarType(Array1(Ndx1)) = vbUserDefinedType Then
    Exit Function
    End If
    Next Ndx1

    For Ndx1 = LBound(Array2) To UBound(Array2)
    If IsObject(Array2(Ndx1)) = True Then
    Exit Function
    End If
    If VarType(Array2(Ndx1)) >= vbArray Then
    Exit Function
    End If
    If VarType(Array2(Ndx1)) = vbUserDefinedType Then
    Exit Function
    End If
    Next Ndx1

    Ndx1 = LBound(Array1)
    Ndx2 = Ndx1
    ResNdx = LBound(ResultArray)
    Done = False
    Do Until Done = True
    ''''''''''''''''''''''''''''''''''''
    ' Loop until we reach the end of
    ' the array.
    ''''''''''''''''''''''''''''''''''''
    If IsNumeric(Array1(Ndx1)) = True And IsNumeric(Array2(Ndx2)) Then
    D1 = CDbl(Array1(Ndx1))
    D2 = CDbl(Array2(Ndx2))
    If D1 = D2 Then
    ResultArray(ResNdx) = 0
    ElseIf D1 < D2 Then
    ResultArray(ResNdx) = -1
    Else
    ResultArray(ResNdx) = 1
    End If
    Else
    S1 = CStr(Array1(Ndx1))
    S2 = CStr(Array2(Ndx1))
    ResultArray(ResNdx) = StrComp(S1, S2, Compare)
    End If

    ResNdx = ResNdx + 1
    Ndx1 = Ndx1 + 1
    Ndx2 = Ndx2 + 1
    ''''''''''''''''''''''''''''''''''''''''
    ' If Ndx1 is greater than UBound(Array1)
    ' we've hit the end of the arrays.
    ''''''''''''''''''''''''''''''''''''''''
    If Ndx1 > UBound(Array1) Then
    Done = True
    End If
    Loop

    CompareArrays = True
    End Function
    Rbert

  5. #5
    Join Date
    Jan 2011
    Location
    Grand Haven / Royal Oak Michigan USA
    Posts
    23
    I missed this "If for a reason I don't understand, you cannot perform the comparison while looping into the recordsets (which would probably be the most efficient way)"... The sky is the limit... all I need is a suggestion.
    Rbert

  6. #6
    Join Date
    Jan 2011
    Location
    Grand Haven / Royal Oak Michigan USA
    Posts
    23
    I tried this out and the second singular value returned for strType is WORK which is present in strStats but it is still blowing past If InStr(strType, strStats) Then any ideas???

    Private Sub AlertTypeID_AfterUpdate()
    '************************************************* ******************************************
    '* MOD RAL 12/09/2011 Code To Compare Status Types *
    '************************************************* ******************************************
    If Me.AlertTypeID.Column(0) = 4 Then
    Dim strPrj, strType, strTypes, strCSR1, strCSR2, strStats As String
    Dim rstType, rstStat As Recordset
    Dim blnStat As Boolean
    Stop

    strCSR1 = "SELECT DISTINCT [tblIBMCSRStatus].[StatusCode] "
    strCSR1 = strCSR1 & "FROM [tblIBMCSRStatus] "
    strCSR1 = strCSR1 & "WHERE (((tblIBMCSRStatus.StatusCode)<>'CANC')) AND (((tblIBMCSRStatus.StatusCode)<>'COMP'))"

    Set rstStat = CurrentDb.OpenRecordset(strSQL)

    strStats = ""
    If rstStat.RecordCount > 0 Then
    rstStat.MoveFirst
    While Not rstStat.EOF
    If strStats = "" Then
    strStats = ""
    Else
    strStats = strStats & ", "
    End If
    strStats = strStats & IIf(IsNull(rstStat(0).Value), "", rstStat(0).Value)
    rstStat.MoveNext
    Wend
    End If
    rstStat.Close

    strPrj = Me!ProjectID

    strCSR2 = "SELECT [tblIBMCSR].[Field60] "
    strCSR2 = strCSR2 & "FROM [tblIBMCSR] "
    strCSR2 = strCSR2 & "WHERE [tblIBMCSR].[Field5]= '" & strPrj & "'"

    Set rstType = CurrentDb.OpenRecordset(strSQL)

    strType = ""
    strTypes = ""
    If rstType.RecordCount > 0 Then
    rstType.MoveFirst
    While Not rstType.EOF
    If strTypes = "" Then
    strType = ""
    strTypes = ""
    Else
    If InStr(strType, strStats) Then
    DoCmd.Beep
    MsgBox "Status Information - Communication Type.", vbCritical, "Outstanding CSR Status Prevents This Action..."
    Set Me!AlertTypeID.Column(0) = 2
    Me!AlertTypeID.SetFocus
    Else
    strType = ""
    strTypes = strTypes & ", "
    End If
    End If
    strType = strType & IIf(IsNull(rstType(0).Value), "", rstType(0).Value)
    strTypes = strTypes & IIf(IsNull(rstType(0).Value), "", rstType(0).Value)
    rstType.MoveNext
    Wend
    End If
    rstType.Close
    Else
    Exit Sub
    End If

    End Sub
    Rbert

  7. #7
    Join Date
    Jan 2011
    Location
    Grand Haven / Royal Oak Michigan USA
    Posts
    23
    I commented out the first collection and set strStats = "WORK" and on the second loop when the WORK was returned for strType If InStr(strType, strStats) performed as expected… sadness I was thinking If InStr had magical capabilities.
    Rbert

  8. #8
    Join Date
    Jan 2011
    Location
    Grand Haven / Royal Oak Michigan USA
    Posts
    23
    This is how I ended up stating what I was after:

    Private Sub AlertTypeID_AfterUpdate()
    '************************************************* ******************************************
    '* MOD RAL 12/09/2011 Code To Compare Status Types *
    '************************************************* ******************************************
    If Me.AlertTypeID.Column(0) = 4 Then
    Dim strPrj, strType, strTypes, strCSR1, strCSR2, strStats As String
    Dim rstType, rstStat As Recordset
    Dim blnStat As Boolean
    Stop

    strPrj = Me!ProjectID

    strCSR1 = "SELECT [tblIBMCSR].[Field60] "
    strCSR1 = strCSR1 & "FROM [tblIBMCSR] "
    strCSR1 = strCSR1 & "WHERE [tblIBMCSR].[Field5]= '" & strPrj & "'"
    strCSR1 = strCSR1 & "and [tblIBMCSR].[Field60] not in "
    strCSR1 = strCSR1 & "(SELECT DISTINCT [tblIBMCSRStatus].[StatusCode] "
    strCSR1 = strCSR1 & "FROM [tblIBMCSRStatus]"
    strCSR1 = strCSR1 & "WHERE ((([tblIBMCSRStatus].[StatusCode])<>'CANC')) AND ((([tblIBMCSRStatus].[StatusCode])<>'COMP')) )"

    Set rstStat = CurrentDb.OpenRecordset(strCSR1)

    strStats = ""
    If rstStat.RecordCount > 0 Then
    DoCmd.Beep
    MsgBox "Status Information - Communication Type.", vbCritical, "Outstanding CSR Status Prevents This Action..."
    Me!AlertTypeID.SetFocus
    Set Me!AlertTypeID.Column = 6
    Exit Sub
    Else
    Exit Sub
    End If
    Else
    Exit Sub
    End If
    End Sub
    Rbert

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •