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 gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

help with function that scans table data 3

Status
Not open for further replies.

teach314

Technical User
Jul 29, 2011
183
CA
I am asking for some help writing a function.

The function works on TableData, that looks like the following:

Col1 Col2 Col3
0 3 -2
0 2 0
-1 0 0
4 -6 0
0 4 -1
0 -3 0
0 3 0
2 -1 0
6 0 7
-2 -1 0
... et cetera

The function needs to return FALSE if any column has more than 3 consecutive zeroes, or more than 3 consecutive non-zeroes. Otherwise, the function returns TRUE.

In the table shown, FALSE is returned because of the (-6, 4, -3, 3) that appears in the second column.

Thanks in advance for any advice.


 
more than 3 consecutive
Well, how is ordered TableData ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
very sorry PHV - There is an autonumber key, TestID. I can't believe I missed that!

TestID Col1 Col2 Col3
.....
100 0 3 -2
101 0 2 0
102 -1 0 0
103 4 -6 0
104 0 4 -1
105 0 -3 0
106 0 3 0
107 2 -1 0
108 6 0 7
109 -2 -1 0
... et cetera

So, the function needs to return FALSE because it find more than 3 consecutive non-zero values in any column. (the -6, 4, -3, 3) in Col2 causes a FALSE return) More than 3 consecutive values of 0 would also force a return of FALSE.

A VBA solution to this problem would be great, but if it is possible to tackle this problem with SQL instead of VBA, I'd also be very interested. I've not been able to find other postings that deal with this.

many thanks
 
Code:
Public Function HasThreeZeros(domain As String, ParamArray searchFields() As Variant) As Boolean
  'domain should be a query sorted on your sort field
  Dim rs As DAO.Recordset
  Dim fld As DAO.Field
  Dim searchField As Variant
  Dim zeroCount As Integer
  
  Set rs = CurrentDb.OpenRecordset(domain)
  For Each searchField In searchFields
    rs.MoveFirst
    zeroCount = 0
    Do While Not rs.EOF
      If rs.Fields(searchField) = 0 Then
        zeroCount = zeroCount + 1
      Else
        zeroCount = 0
      End If
      If zeroCount = 3 Then
        HasThreeZeros = True
        Exit Function
      End If
      rs.MoveNext
    Loop
  Next searchField
End Function

Code:
msgbox hasThreeZeros("qryOne","col1","col2","col3")
 

Just a guess, code not tested.
I just did one column (Col1) but you can easy add 2 other columns with the same logic. You can also pass a recordset (rst) to this Function:
Code:
Private Function ScanTable() As Boolean
Dim bln As Boolean
Dim Col1Zero As Integer
Dim Col1NonZero As Integer

With rst
  Do While Not .EOF
    If !Col1.Value = 0 Then
      Col1Zero = Col1Zero + 1
      Col1NonZero = 0
    Else
      Col1NonZero = Col1NonZero + 1
      Col1Zero = 0
    End If

    If Col1Zero > 3 Or Col1NonZero > 3 Then
      bln = True
      Exit Loop
    End If

    .MoveNext
  Loop
End With

ScanTable = Not(bln)

End Function

Have fun.

---- Andy
 
Sorry did not see you want any three consecutive. The function returns true if there is three consecutive. This function works with any amount of fields and any data type.

Code:
Public Function HasThreeConsec(domain As String, ParamArray searchFields() As Variant) As Boolean
  'domain should be a query sorted on your sort field
  Dim rs As DAO.Recordset
  Dim fld As DAO.Field
  Dim searchField As Variant
  Dim consecCount As Integer
  Dim tempVal as variant
  
  Set rs = CurrentDb.OpenRecordset(domain)
  For Each searchField In searchFields
    rs.MoveFirst
    consecCount = 1
    tempVal = rs.Fields(searchField)
    If Not rs.EOF Then rs.MoveNext
    Do While Not rs.EOF
       If rs.Fields(searchField) = tempVal Then
        consecCount = consecCount + 1
      Else
        tempVal = rs.Fields(searchField)
        consecCount = 1
      End If
      If consecCount = 3 Then
        HasThreeConsec = True
        Exit Function
      End If
      rs.MoveNext
    Loop
  Next searchField
End Function
 
hi MajP - this code is getting very close, but I think there is one small problem (I may not have expressed something clearly enough). The code can find more than 3 consecutive 0's (0 0 0 0), or 3 consecutive -4's, lets say, (-4, -4, -4, -4). But, I need it to detect either

1) more than three 0's in consecutive records (like 0, 0, 0, 0)
OR
2) more than 3 NON-ZEROES in CONSECUTIVE RECORDS (for example, like 5, -1, 4, 4). This is precisely the part of the problem that is giving me grief. It's as if I'd like your 'Searchfield' to have the values 0, then NOT(0).

Many thanks for your thoughts.
 

teach314, did you take a look at my code?
MajP's is very nice, but I think you can use what I came up with and adjust to your needs very easy.

Have fun.

---- Andy
 
It looks like you were clear, I was just dense. Andy seemed to understand it from the beginning.
 
OK maybe I understand now. Basically the same as Andy just a little more flexible to use and query and any fields.
Code:
Public Function HasMoreThanThreeConsec(domain As String, ParamArray searchFields() As Variant) As Boolean
  'domain should be a query sorted on your sort field
  Dim rs As DAO.Recordset
  Dim fld As DAO.Field
  Dim searchField As Variant
  Dim ZeroConsecCount As Integer
  Dim NonZeroConsecCount As Integer
  Dim tempVal
  
  Set rs = CurrentDb.OpenRecordset(domain)
  For Each searchField In searchFields
    rs.MoveFirst
    ZeroConsecCount = 0
    NonZeroConsecCount = 0
    If Not rs.EOF Then rs.MoveNext
    Do While Not rs.EOF
       If rs.Fields(searchField) = 0 Then
        ZeroConsecCount = ZeroConsecCount + 1
        NonZeroConsecCount = 0
      Else
        ZeroConsecCount = 0
        NonZeroConsecCount = NonZeroConsecCount + 1
      End If
      If ZeroConsecCount = 4 Or NonZeroConsecCount = 4 Then
        HasMoreThanThreeConsec = True
        Exit Function
      End If
      rs.MoveNext
    Loop
  Next searchField
End Function
 
Thanks to Andrzejek and MajP for some really nice code. It took me a while to sort through, but both sets of code do a nice job! Teach 314
 
How are ya teach314 . . .

The following should do (along the same logic as [blue]Andrzejek[/blue]. Note ... [blue]you[/blue] substitute proper names in [purple]purple[/purple]:
Code:
[blue]Public Function IsFree3() As Boolean
   Dim db As DAO.Database, rst As DAO.Recordset
   Dim flg As Boolean, fldName As String
   Dim Zero(1 To 3) As Long, NotZero(1 To 3) As Long, idxCol As Integer
   
   Set db = CurrentDb
   Set rst = db.OpenRecordset("[purple][b]TableName[/b][/purple]", dbOpenDynaset)
   flg = True
   
   Do Until rst.EOF
      For idxCol = 1 To 3
         fldName = Choose(idxCol, "[purple][b]FieldName1[/b][/purple]", "[purple][b]FieldName2[/b][/purple]", "[purple][b]FieldName3[/b][/purple]")
         If rst(fldName) = 0 Then
            Zero(idxCol) = Zero(idxCol) + 1
            NotZero(idxCol) = 0
         Else
            NotZero(idxCol) = NotZero(idxCol) + 1
            Zero(idxCol) = 0
         End If
         
         If Zero(idxCol) > 3 Or NotZero(idxCol) > 3 Then flg = False
      Next
      
      If Not flg Then Exit Do
      rst.MoveNext
   Loop
   
   IsFree3 = flg
   
   Set rst = Nothing
   Set db = Nothing
   
End Function[/blue]

[blue]Your Thoughts . . .[/blue]

See Ya! . . . . . .

Be sure to see faq219-2884 [blue]Worthy Reading![/blue] [thumbsup2]
Also faq181-2886 [blue]Worthy Reading![/blue] [thumbsup2]
 
Three great solutions (Andrezejek, MajP, TheAceMan1) using a variety of different ideas!
 
Actually they are all pretty much the same idea slightly modified. Any chance you can describe the big picture of what you are doing? Your data looks non-normal and maybe there is a better design or solution for this.
 
I'm not entirely aware of the 'big picture' because I'm helping a friend in my department who knows even less about coding than I do! I was just given large Excel files, so that's why the data is not normalized. In any case, I'll try running the tables through a normalizing query, then see if I can streamline things even more.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top