Results 1 to 17 of 17

Thread: Ideas for Locating a missing/unused record in a RecordSet

  1. #1

    Thread Starter
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Ideas for Locating a missing/unused record in a RecordSet

    Think some of you might have done this and I have a solution, but wondering if there are others, possibly better overall?

    The scenario: I have a disconnected recordset, not tied to any database. Within it, there is a field that can contain values within a fixed range. Looking for efficient ways of locating an available/unused item within that range.

    For argument sake, we'll say the range is 0 to 65535. And the recordset's field "ID" field contains values within that range. The value can be anywhere within that range, user-defined. Therefore automating can't be done. However, the goal here is to auto-select a default if the user doesn't care which ID is used.

    The logic for the above is simple: If user doesn't care, we can select a value that is before the lowest or after the highest used so far, unless the range's Min/Max (0 & 65535) are already used.

    My solution is a binary search within the recordset. Haven't attempted a binary search for missing/unused items before, so not sure it's the best option; though it was fun developing it. We'll assume at least a few dozen range items are being used, but in the test, we are using all but one range item

    Code:
    Private Function BinaryTestRS(RS As ADODB.Recordset, IDField As Long) As Long
    
        ' Passed RS should be a clone if you don't want the recordset positions moving around: yourRS.Clone
        ' Assumptions:
        '   The range of items in the recordsest is assumed to be missing at least one item
        '       RangeMax - RangeMin + 1 > recordset.RecordCount
        '   The min/max range items are assumed already in use, else those should be used instead of calling this routine
        '       recordset.MoveLast: If RangeMax > recordset.Fields(x).Value Then use recordset.Fields(x).Value + 1
        '       recordset.MoveFirst: If recordset.Fields(x).Value > RangeMin Then use recordset.Fields(x).Value - 1
        '   In other words, this routine assumes record @ .MoveFirst is RangeMin and record @ .MoveLast is RangeMax
        
        ' Return value will be a value between RangeMin & RangeMax
        ' If the recordset is 100% full, no available values between RangeMin & RangeMax. Return value is RangeMin-1
    
        Dim UB As Long, LB As Long, newIndex As Long
        Dim recUB As Long, recNext As Long
        
        Dim lIterations As Long ' testing
    
        RS.Sort = "[" & RS.Fields(IDField).Name & "]"
        RS.MoveLast
        UB = RS.AbsolutePosition                ' get nr of records
        recUB = RS.Fields(IDField).Value        ' and cache value of last record
        RS.MoveFirst                            ' ensure the implied range is not 100% full
        If UB >= recUB - RS.Fields(0).Value + 1 Then
            BinaryTestRS = RS.Fields(0).Value - 1
            Exit Function
        End If
        LB = 1
    
        Do Until LB > UB:                       lIterations = lIterations + 1
            newIndex = LB + ((UB - LB) \ 2) ' set position to look at & get value at that position
            RS.Move newIndex - RS.AbsolutePosition: recNext = RS.Fields(IDField).Value
            RS.MovePrevious
            If recNext - RS.Fields(IDField).Value > 1 Then Exit Do ' check for gap of 1+ & exit if found
            
            If recUB - recNext = UB - newIndex Then ' no gaps in this range, move to lower range
                UB = newIndex - 1       ' set upper limit for next range & get value at that position
                recUB = RS.Fields(IDField).Value
            Else                        ' zeroing in on the range
                LB = newIndex + 1
            End If
        Loop
        ' newIndex will be the record after the available item.
        ' Recordset is already positioned at newIndex-1. We just add 1 to that value & done.
        ' Note: If the gap at this position is > 1, then multiple consecutive values are available.
        BinaryTestRS = RS.Fields(IDField).Value + 1
    
    Debug.Print "iterations used to find missing item below:"; lIterations
    End Function
    And a simple test routine...
    1. Add the Microsoft ActiveX Data Objects library to a test project
    2. Add a button to the form
    3. Copy the above routine
    4. In the button's click event
    Code:
        Dim RS As ADODB.Recordset, crs As ADODB.Recordset
        Dim x As Long, p As Long
        
        Set RS = New ADODB.Recordset
        RS.Fields.Append "RecID", adInteger
        RS.Open
        
        For x = 30001 To 65535   ' fill up the range 0-65535
            RS.AddNew
            RS.Fields(0).Value = x
        Next
        For x = 0 To 30000
            RS.AddNew
            RS.Fields(0).Value = x
        Next
        RS.UpdateBatch
        
        For x = 1 To 20                 ' randomly pick a record to delete
            p = Int(Rnd * 65535) + 1
            If p = 1 Or p = 65535 Then
                Debug.Print "binary search not called, use ID;p"
            Else
                RS.Move p - 1, 1        ' move to record
                p = RS.Fields(0)        ' cache so we can re-add it later
                RS.Delete               ' delete it
                RS.Update
                Set crs = RS.Clone      ' see if binary routine can find missing item
                Debug.Print "deleted ID"; p; " found "; BinaryTestRS(crs, 0)
                RS.AddNew
                RS.Fields(0).Value = p  ' add it back; won't be in any sort order
                RS.Update
                crs.Close: Set crs = Nothing
            End If
            
        Next
        RS.Close: Set RS = Nothing
    End Sub
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  2. #2
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: Ideas for Locating a missing/unused record in a RecordSet

    These efforts (looking for gaps in an Rs-ID-Range) are IMO not necessary,
    when you make use of already available features of the ADO-Recordset:

    Wouldn't it be nice, when a (disconnected, or ClientCursor-based) Rs would support a kind of "snapshot" -
    and then internally doing a "record-keeping" of what was changed (literally)?

    That would allow us, to find deleted Records (as well as newly added ones) -
    and thus we'd be able to come up at any time, with a list of "free IDs".

    Well, the following example shows what an ADO-Rs has to offer in that regard::
    Code:
    Option Explicit
    
    Private Rs As ADODB.Recordset
    
    Private Sub Form_Load()
      Caption = "Click Me"
      Set Rs = New ADODB.Recordset
          Rs.Fields.Append "ID", adInteger
          Rs.Open
          
            Dim ID As Long
            For ID = 30001 To 65535: Rs.AddNew 0, ID: Next
            For ID = 0 To 30000:     Rs.AddNew 0, ID: Next
            
          Rs.UpdateBatch 'now, let's make a "snap-shot" of the status-quo
    End Sub
    
    Private Sub Form_Click()
      If FindRec(Rs, "ID=5") Then Rs.Delete 'find and delete the Record with ID=5
      
      Rs.AddNew: Rs!ID = 5                  '(re)-add a Record with the same ID=5
      
      If FindRec(Rs, "ID=3") Then           'find ID=3 and invert it to -3
        Rs!ID = -3
      ElseIf FindRec(Rs, "ID=-3") Then      'if not found, search for ID=-3 and invert it again
        Rs!ID = 3
      End If
      
      PrintChangedRecords Rs                'and here's where "the magic" happens
    End Sub
    
    'just two little Helper-Routines for more convenience
    Function FindRec(Rs As ADODB.Recordset, Criterion As String) As Boolean
      Rs.Find Criterion, , , adBookmarkFirst
      If Not (Rs.EOF Or Rs.BOF) Then FindRec = True
    End Function
    
    Private Sub PrintChangedRecords(Rs As ADODB.Recordset)
      AutoRedraw = True: Cls
      With Rs.Clone
        .Filter = adFilterPendingRecords '<- this being the Filter-Option, many are not aware of
        Do Until .EOF
          Select Case .Status
            Case adRecDeleted:  Print "Found Deleted -> Orig-IDValue: "; !ID.OriginalValue
            Case adRecNew:      Print "Found Added -> New-IDValue: "; !ID.Value
            Case adRecModified: Print "Modified -> Orig-IDValue: "; !ID.OriginalValue; " Actual-IDValue: "; !ID.Value
          End Select
          .MoveNext
        Loop
      End With
    End Sub
    HTH

    Olaf

  3. #3

    Thread Starter
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Ideas for Locating a missing/unused record in a RecordSet

    Olaf, the recordset is an existing file that I have no full control over. I didn't mention that in the first post and probably should've; my bad. Your solution is interesting nonetheless, but doesn't quite fit my situation.

    Additionally, you are tracking changes. There will likely exist thousands of available/unused items relative to the recordset. I just need to pick one and want to avoid a linear search as there also could be many items already in use. With the binary search, in the 65K example, a max of 16 iterations will be used. So, a quick and dirty rule of thumb: recordset less than 20, linear search, else use a more efficient algo.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  4. #4
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: Ideas for Locating a missing/unused record in a RecordSet

    Quote Originally Posted by LaVolpe View Post
    Olaf, the recordset is an existing file that I have no full control over. I didn't mention that in the first post and probably should've; my bad.
    Your solution is interesting nonetheless, but doesn't quite fit my situation.
    I'd say it can be easily adapted to fit also for your scenario
    (I'd write an example, when you'd post your "existing file" (or something like it) and a bit more info, what the purpose of the exercise is.

    Olaf

  5. #5

    Thread Starter
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Ideas for Locating a missing/unused record in a RecordSet

    Can't upload a real example; data not public use. However, simply create a recordset (1 field) having 5+ blocks of records where each block contains say 10 consecutive values, i.e., 0,1,2,3,5,6,7,8,9 50,51,52,53,54,55,56,57,58,59 etc.

    As it stands now, I have no need to track any data while being added to the recordset; no need to even look at those fields as they are imported especially since I don't have control over them, other to later add/edit/delete them as user requests. Keeping a list of unused items is not an option and that list can exceed the count of items actually used. The task is really simple. Given a list, find a gap between any two consecutive values in the list. Binary searches are relatively quick. Options do exist with SQL queries, but not applicable to disconnected recordsets.

    Edited: the example in 1st post is absolute worst-case scenario... only 1 available item left to be selected.
    Last edited by LaVolpe; Dec 5th, 2017 at 04:26 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  6. #6
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: Ideas for Locating a missing/unused record in a RecordSet

    I didn't follow the "user cares, user doesn't care" part.

    If the user "cares" what does that mean? Return the next larger unused value if the one the user cares about exists?

    If the user doesn't care just return any unused value?

  7. #7

    Thread Starter
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Ideas for Locating a missing/unused record in a RecordSet

    User cares... They will assign a value for newly appended items
    User doesn't care... auto-select the value for them. User can change it later if desired. Typical if appending multiple items at once.

    Edited: Details may be a distraction...
    Given a list, find a gap between any two consecutive values in the list. Contiguous items in the list can be dozens upon dozens. Looking for different techniques, especially if sorting is optional. But being a recordset, 1/2 million items can be sorted quickly, so asking for solutions on unsorted lists is unrealistic. I'd think a linear search would be last resort.
    Last edited by LaVolpe; Dec 5th, 2017 at 04:36 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  8. #8
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: Ideas for Locating a missing/unused record in a RecordSet

    Quote Originally Posted by LaVolpe View Post
    Can't upload a real example; data not public use. However, simply create a recordset (1 field) having 5+ blocks of records where each block contains say 10 consecutive values, i.e., 0,1,2,3,5,6,7,8,9 50,51,52,53,54,55,56,57,58,59 etc.
    Well, I see better now what you're trying to do (you're not trying to "work backwards" from a fully settled range, for which my suggestion in #2 would work quite well).

    Quote Originally Posted by LaVolpe View Post
    The task is really simple. Given a list, find a gap between any two consecutive values in the list. Binary searches are relatively quick.
    It is indeed not really complicated - but the way your algo is currently implemented - the search is not quick at all.

    Here is an example (for your suggested range of [1-0.5Mio] Records in the Rs) -
    the Timings from an (MS-Scripting)-Dictionary-based "Free-ID-List" approach:


    Here is your BinSearch-approach in comparison (had to reduce the range by factor 100, to only [1-5Tsd] Records):


    To test that yourself, you need a Form with two CommandButtons (Command1 and Command2) -
    plus added references to MS-ASO and the MS-Scripting-Dictionary...

    Into the TestForm then:
    Code:
    Option Explicit
     
    Private Sub Form_Load()
      Caption = "Test-Form": FontSize = 10: FontName = "Arial": AutoRedraw = True
      Command1.Caption = "Dictionary"
      Command2.Caption = "BinSearch"
    End Sub
    
    Private Sub Command1_Click()
      Cls
      Dim Rs As New ADODB.Recordset, FreeIds As New cFreeIDs1, T!, n&
          Rs.Fields.Append "ID", adInteger
          Rs.Open
            Dim ID As Long 'LB=1, UB=500000, Gaps: [100001-200000],[300001-400000]
            For ID = 400001 To 500000: Rs.AddNew 0, ID: Next
            For ID = 1 To 100000:      Rs.AddNew 0, ID: Next
            For ID = 200001 To 300000: Rs.AddNew 0, ID: Next
          Rs.UpdateBatch
      Print vbLf; "Dictionary-approach: on an Rs-Range of 1 to 500000"
      
      Print vbLf; "Free-Ids-preparation:": DoEvents: T = Timer 'just to measure, how long it takes to bind and prepare the Helper-Object
        FreeIds.BindTo Rs, "ID"
      Print "  RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
      
      Print vbLf; "AddNew/Delete-pair:": DoEvents: T = Timer
        For n = 1 To 100000  'let's do (100000 times) a basically non-Rs-changing "Double-Op"...
          FreeIds.AddNew Rs 'performing an AddNew (with one of the free IDs)
          FreeIds.Delete Rs 'followed by a Delete on the same (just added) Record of our Rs
        Next
      Print "  RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
     
      Print vbLf; "AddNew until full:": DoEvents: T = Timer
        For n = 1 To FreeIds.Count 'well, now we get serious and add new Records, till there are no free IDs anymore
          FreeIds.AddNew Rs
        Next
      Print "  RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
      
      Rs.Sort = "ID": n = 1 'sanity-checks on the final Rs-Content
      If Rs.RecordCount <> 500000 Then MsgBox "shouldn't happen"
      Do Until Rs.EOF
        If Rs.Fields(0) <> n Then MsgBox "shouldn't happen"
        Rs.MoveNext: n = n + 1
      Loop
    End Sub
    
    Private Sub Command2_Click()
      Cls
      Dim Rs As New ADODB.Recordset, FreeIds As New cFreeIDs2, T!, n&
          Rs.Fields.Append "ID", adInteger
          Rs.Open
            Dim ID As Long 'LB=1, UB=5000, Gaps: [1001-2000],[3001-4000]
            For ID = 4001 To 5000: Rs.AddNew 0, ID: Next
            For ID = 1 To 1000:    Rs.AddNew 0, ID: Next
            For ID = 2001 To 3000: Rs.AddNew 0, ID: Next
          Rs.UpdateBatch
      Print vbLf; "BinSearch-approach: on an Rs-Range of 1 to 5000"
         
      Print vbLf; "Free-Ids-preparation:": DoEvents: T = Timer 'just to measure, how long it takes to bind and prepare the Helper-Object
        FreeIds.BindTo Rs, "ID"
      Print "  RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
      
      Print vbLf; "AddNew/Delete-pair:": DoEvents: T = Timer
        For n = 1 To 1000  'let's do (1000 times) a basically non-Rs-changing "Double-Op"...
          FreeIds.AddNew Rs 'performing an AddNew (with one of the free IDs)
          FreeIds.Delete Rs 'followed by a Delete on the same (just added) Record of our Rs
        Next
      Print "  RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
      
      Print vbLf; "AddNew until full:": DoEvents: T = Timer
        For n = 1 To 2000 'well, now we get serious and add new Records, till there are no free IDs anymore
          FreeIds.AddNew Rs
        Next
      Print "  RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
      
      Rs.Sort = "ID": n = 1 'sanity-checks on the final Rs-Content
      If Rs.RecordCount <> 5000 Then MsgBox "shouldn't happen"
      Do Until Rs.EOF
        If Rs.Fields(0) <> n Then MsgBox "shouldn't happen"
        Rs.MoveNext: n = n + 1
      Loop
    End Sub
    Into a Class cFreeIds1 (for the Dictionary-based approach):
    Code:
    Option Explicit
     
    Private mFieldName As String, mD As New Scripting.Dictionary
    
    Public Sub BindTo(Rs As ADODB.Recordset, FieldName As String, Optional LB, Optional UB)
      mFieldName = FieldName
      With Rs.Clone
        Dim F As ADODB.Field, B() As Byte, i As Long
        Set F = .Fields(mFieldName)
           .Sort = "[" & mFieldName & "]"
           .MoveLast:  UB = F.Value
           .MoveFirst: LB = F.Value
        ReDim B(LB To UB)
        Do Until .EOF: B(F.Value) = 1: .MoveNext: Loop
      End With
      
      Set mD = Nothing
      For i = LB + 1 To UB - 1
        If B(i) = 0 Then mD.Add i, i
      Next
    End Sub
     
    Public Property Get Count() As Long
      Count = mD.Count
    End Property
    
    Public Function AddNew(Rs As ADODB.Recordset, Optional ID)
      If Count = 0 Then Err.Raise vbObjectError, , "No free IDs available anymore..."
      For Each ID In mD
        Rs.AddNew mFieldName, ID: Exit For 'fill the ByRef-ID (in case someone on the outside is interested)
      Next
      Rs.Update: mD.Remove ID
    End Function
    
    Public Function Delete(Rs As ADODB.Recordset, Optional ID)
      If Rs.RecordCount = 0 Then Err.Raise vbObjectError, , "No Records to delete"
      If Rs.EOF Or Rs.BOF Then Err.Raise vbObjectError, , "Either EOF or BOF is true"
      ID = Rs(mFieldName).Value
      mD.Add ID, ID
      Rs.Delete: Rs.Update
    End Function
    Into a Class cFreeIds2 (for your BinSearch-based approach):
    Code:
    Option Explicit
    
    Private mFieldName As String, mLB As Long, mUB As Long
    
    Public Sub BindTo(Rs As ADODB.Recordset, FieldName As String, Optional LB, Optional UB)
      mFieldName = FieldName
      With Rs.Clone 'fill the ByRef-Params (in case someone is interested on the outside)
        .Sort = "[" & mFieldName & "]"
        .MoveLast:  UB = .Fields(mFieldName).Value
        .MoveFirst: LB = .Fields(mFieldName).Value
      End With
      mLB = LB
      mUB = UB
    End Sub
     
    Public Property Get Count()
      Count = "not available" 'with the choosen approach
    End Property
    
    Public Function AddNew(Rs As ADODB.Recordset, Optional ID)
      ID = BinaryTestRS(Rs) 'fill the ByRef-ID (in case someone on the outside is interested)
      If ID >= mLB Then
        Rs.AddNew mFieldName, ID
        Rs.Update
      End If
    End Function
    
    Public Function Delete(Rs As ADODB.Recordset, Optional ID)
      If Rs.RecordCount = 0 Then Err.Raise vbObjectError, , "No Records to delete"
      If Rs.EOF Or Rs.BOF Then Err.Raise vbObjectError, , "Either EOF or BOF is true"
      ID = Rs(mFieldName).Value
      Rs.Delete: Rs.Update
    End Function
     
    Private Function BinaryTestRS(ByVal Rs As ADODB.Recordset) As Long
        ' Assumptions:
        '   The range of items in the recordsest is assumed to be missing at least one item
        '       RangeMax - RangeMin + 1 > recordset.RecordCount
        '   The min/max range items are assumed already in use, else those should be used instead of calling this routine
        '       recordset.MoveLast: If RangeMax > recordset.Fields(x).Value Then use recordset.Fields(x).Value + 1
        '       recordset.MoveFirst: If recordset.Fields(x).Value > RangeMin Then use recordset.Fields(x).Value - 1
        '   In other words, this routine assumes record @ .MoveFirst is RangeMin and record @ .MoveLast is RangeMax
        
        ' Return value will be a value between RangeMin & RangeMax
        ' If the recordset is 100% full, no available values between RangeMin & RangeMax. Return value is RangeMin-1
    
        Dim UB As Long, LB As Long, newIndex As Long
        Dim recUB As Long, recNext As Long, F As ADODB.Field
        Dim lIterations As Long ' testing
        
        Set Rs = Rs.Clone 'we make the clone directly here (from a Byval passed Rs-ObjPtr)
        Set F = Rs.Fields(mFieldName)
        Rs.Sort = "[" & F.Name & "]"
        Rs.MoveLast
        UB = Rs.AbsolutePosition                ' get nr of records
        recUB = F.Value        ' and cache value of last record
        Rs.MoveFirst                            ' ensure the implied range is not 100% full
        If UB >= recUB - F.Value + 1 Then
            BinaryTestRS = F.Value - 1
            Rs.Close
            Exit Function
        End If
        LB = 1
    
        Do Until LB > UB
            lIterations = lIterations + 1
            newIndex = LB + ((UB - LB) \ 2) ' set position to look at & get value at that position
            Rs.Move newIndex - Rs.AbsolutePosition: recNext = F.Value
            Rs.MovePrevious
            If recNext - F.Value > 1 Then Exit Do ' check for gap of 1+ & exit if found
            
            If recUB - recNext = UB - newIndex Then ' no gaps in this range, move to lower range
                UB = newIndex - 1       ' set upper limit for next range & get value at that position
                recUB = F.Value
            Else                        ' zeroing in on the range
                LB = newIndex + 1
            End If
        Loop
        ' newIndex will be the record after the available item.
        ' Recordset is already positioned at newIndex-1. We just add 1 to that value & done.
        ' Note: If the gap at this position is > 1, then multiple consecutive values are available.
        BinaryTestRS = F.Value + 1
        Rs.Close
    'Debug.Print "iterations used to find missing item below:"; lIterations
    End Function
    The two Classes are calling-compatible (Interface-wise) - though in your approach the "FreeIDs-Count" is not available of course...

    Tried already to optimize your approach a bit (but didn't try real hard) - maybe you can squeeze more out of it.
    (FWIW, you now have something to compare it to...).

    Olaf

  9. #9
    PowerPoster ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    3,046

    Re: Ideas for Locating a missing/unused record in a RecordSet

    Hi,
    I can't see any advantage in doing this (search a range for a number)

    here what I use for getting Table Information regarding ID's und how many records are in the Table
    I use ADOX

    for getting the next available ID (Autoincrement)
    Code:
    Private Sub Command10_Click()
    'Get the next available ID
    
    Dim Cat As ADOX.Catalog
    Dim Tbl As ADOX.Table
    Dim Col As ADOX.Column
    Dim Cn As ADODB.Connection
    
    Dim strPathToDB As String
       strPathToDB = "D:\Northwind.mdb"
    
    Set Cn = New ADODB.Connection
        With Cn
            .CursorLocation = adUseClient
            .Mode = adModeShareDenyNone
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = strPathToDB
    
            ' if Password :
            '.Properties("Jet OLEDB:Database Password") = "testdb"
    
           ' if System- und Securety-MDW
           ' .Properties("Jet OLEDB:System database") = "D:\Test_DBs\Access\db3.mdw"
    
            ' UserId // User
            '.Properties("User ID") = "xyz"
    
            ' Password for Users
            '.Properties("Password") = "myPass"
            .Open
        End With
    Set Cat = New ADOX.Catalog
    Cat.ActiveConnection = Cn
        Set Tbl = Cat.Tables("Employees")
        Set Col = Tbl.Columns("EmployeeID")
        
        'method 1:
        'MsgBox Col.Properties("Seed").Value
    
        'method 2:
       MsgBox Cat("Employees")("EmployeeID").Properties("Seed").Value
    End Sub
    for Table Information..
    Code:
    Private Sub Command6_Click()
    GetTableInfo Cn, "Employees"
    End Sub
    
    
    Public Function GetTableInfo(Cn As ADODB.Connection, _
                                 sTable As String, _
                                 Optional RecordCount As Long, _
                                 Optional DateCreated As Date, _
                                 Optional DateModified As Date) As Boolean
    
       Dim Rs As ADODB.Recordset
       
          'Filter: pass Table name for Information
          Set Rs = Cn.OpenSchema(adSchemaTables, _
                                 Array(Empty, Empty, sTable, "Table"))
          If Rs.EOF Or Rs.BOF Then
             Rs.Close
             Set Rs = Nothing
             Exit Function
          End If
         
          DateCreated = Rs.Fields("Date_Created").Value
          DateModified = Rs.Fields("Date_Modified").Value
    
            Debug.Print Rs.Fields("Date_Created").Value
            Debug.Print Rs.Fields("Date_Modified").Value
    
          Set Rs = Cn.OpenSchema(adSchemaStatistics, _
                                 Array(Empty, Empty, sTable))
    
          RecordCount = Rs.Fields("Cardinality").Value 'get how many Records
          
            Debug.Print Rs.Fields("Cardinality").Value
    
          GetTableInfo = True
          Rs.Close
          Set Rs = Nothing
    End Function
    one could also create a new Table with a specific AutoID starting at a specific Number ( say 50000)

    Code:
    Private Sub Command24_Click()
    Dim strSQL As String
    
     'start AutoID where you want. MyID is the Autoincrement value
    strSQL = "Insert Into tbl_IdStartwith (MyID,myName) Values (49999,'Test')"
     
    Cn.Execute strSQL
    End Sub
    regards
    Chris
    Last edited by ChrisE; Dec 6th, 2017 at 06:32 AM.
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

  10. #10

    Thread Starter
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Ideas for Locating a missing/unused record in a RecordSet

    @Chris. Already mentioned, this is a disconnected recordset, not related to a database.

    @Olaf. Will look closer at your solution. Though I will admit, not keen on building some lookup object to store additional information that may not be used or not used often.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  11. #11
    PowerPoster ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    3,046

    Re: Ideas for Locating a missing/unused record in a RecordSet

    Quote Originally Posted by LaVolpe View Post
    @Chris. Already mentioned, this is a disconnected recordset, not related to a database.
    Hi,
    then I don't understand it at all.

    what do you do with the Data ? do you reconnect to some Table in a Database ?


    regards
    Chris
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

  12. #12

    Thread Starter
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Ideas for Locating a missing/unused record in a RecordSet

    Chris. A disconnected recordset can be used for far more things than relating to some database table. Anything you can think of that can be used by a single Excel sheet, can also be used via a recordset. It's just a collection of data and can be persisted to file in recordset format and read later as needed.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  13. #13
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: Ideas for Locating a missing/unused record in a RecordSet

    Yes, fabricated Recordsets can be a useful alternative to Collection, Scripting.Dictionary, and similar classes.

    They can be indexed and sorted at the Field level, can hold multiple values, support filtering, can even be persisted to disk and later loaded from disk. They can also save/load using a Stream object, which makes it easy to transmit them via TCP or HTTP.

    See the attachment "Disconnecting ADO" here: http://www.vbforums.com/showthread.p...=1#post4843967

    I don't know of anywhere else on the web that has this classic PowerPoint online anymore.

  14. #14
    PowerPoster ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    3,046

    Re: Ideas for Locating a missing/unused record in a RecordSet

    Hi,
    @LaVolpe got it now

    @dillettante, thanks for Link, it is a good read.

    I sometimes use offline Recordsets, when reconnecting to the Table an Update takes place.

    thanks to both of you

    regards
    Chris
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

  15. #15

    Thread Starter
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Ideas for Locating a missing/unused record in a RecordSet

    @dilettante. Nice PPT presentation. Didn't know about the Optimize property.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  16. #16
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: Ideas for Locating a missing/unused record in a RecordSet

    A comprehensive guide on disconnected recordsets would have been nice, not sure if I have anything like that handy.
    The PPT touched on adMashalModifiedOnly, but it didn't cover how to control what SQL is generated, like the WHERE condition that tests if modified values were changed on the server before applying the new value.

  17. #17
    PowerPoster ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    3,046

    Re: Ideas for Locating a missing/unused record in a RecordSet

    Quote Originally Posted by LaVolpe View Post
    Chris. A disconnected recordset can be used for far more things than relating to some database table. Anything you can think of that can be used by a single Excel sheet, can also be used via a recordset. It's just a collection of data and can be persisted to file in recordset format and read later as needed.
    Hi,

    this concept of searching for Number(s) in a Range is bugging me. Let's take your example with the Excel Sheet
    what would the Sheet contain and how would the Sheet look like.

    EDIT:
    I just set up a Excelsheet with some Numbers and a Status.
    then this...
    Code:
    Private Sub Form_Load()
    On Error GoTo ErrHandler
        Set cn = New ADODB.Connection
        ' -- connection provider
        cn.Provider = "Microsoft.Jet.OLEDB.4.0"
        cn.ConnectionString = _
            "Data Source=C:\UsedRangeNumber.xls;" & _
            "Extended Properties=Excel 8.0;"
        cn.CursorLocation = adUseClient
        cn.Open
    Exit Sub
    ErrHandler:
        MsgBox "Connection-Fehler"
    End Sub
    
    Private Sub Command2_Click()
        Set rs = New ADODB.Recordset
        rs.Open "SELECT Status, Number From [Tabelle1$] Where Status ='not used' AND Number Between 50 And 250 ", cn, adOpenDynamic, adLockOptimistic
        Set DataGrid1.DataSource = rs
    End Sub
    
    Edit: more Sql 
    
    Private Sub Command3_Click()
        Set rs = New ADODB.Recordset
     '1) get lowest number not used in range
    'rs.Open "SELECT Top 1 Status, Number From [Tabelle1$] Where Status ='not used' AND Number Between 50 And 345 ", cn, adOpenDynamic, adLockOptimistic
        
    '2) get numbers in range not used
        rs.Open "SELECT Status, Number From [Tabelle1$] Where Status ='not used' AND Number Between 50 And 345 ORDER BY Number DESC;", cn, adOpenDynamic, adLockOptimistic
    
    '3) get highest number not used in Range
    'rs.Open "SELECT Max(Number) AS [LastNumber], Status" & _
    " From [Tabelle1$]" & _
    " WHERE (((Number) Between 50 And 345))" & _
    " GROUP BY Status" & _
    " HAVING (((Status)='not used'))", cn, adOpenDynamic, adLockOptimistic
    
        Set DataGrid1.DataSource = rs
    End Sub
    regards
    Chris
    Last edited by ChrisE; Dec 7th, 2017 at 08:18 AM.
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

Posting Permissions

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



Click Here to Expand Forum to Full Width