Adding a progress bar while the flexgrid is populating

[Heprox]

I'm finishing up a project that uses a flexgrid to display recordsets. I have a flexgrid that, depending on what button the user chooses the grid populates accordingly. Certain queries take a couple of seconds longer that others, but the grid is adding rows the whole time. I want the progress bar to increase as the rows in the flexgrid increase to allow the user to see the progress of the query.

Private Sub XPButton1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim strsql As String
Dim inti As Integer
Dim wasNull As Boolean
Dim i As Integer
Dim j As Integer
On Error GoTo errhandler
  With MSFItem
    .Clear
    .Rows = 2
    Select Case Index
    Case 0
      .Clear
      .Rows = 2
      .Cols = 6
      .FormatString = "^SKU                                            |^QTY                         |^Size                           |^Color                                        |^First Receive Date                       |^UPC                                                 "
      strsql = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, b.first_rcv_dt, " & _
        " d.upc_cd from gm_inv_loc a, gm_sku b, gm_itm c, gm_sku2upc_cd d" & _
        " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And b.sku_num = d.sku_num" & _
        " and c.itm_cd = '" & lblItemCode.Caption & "' group by a.sku_num, b.size_cd, b.color_des, b.first_rcv_dt, d.upc_cd" & _
        " order by a.sku_num"
    Case 1
      .Clear
      .Rows = 2
      .Cols = 6
      .FormatString = "^Item code                             |^QTY                    |^Store Code                  |^District Code               |^Store Name                                                           |^Square Footage             "
      strsql = "select a.itm_cd, sum(c.avail_qty) qty, c.store_cd, d.op_dist_cd, d.store_name, " & _
        " d.sq_ft from gm_itm a, gm_sku b, gm_inv_loc c, store d" & _
        " Where a.itm_cd = b.itm_cd And b.sku_num = c.sku_num and c.store_cd = d.store_cd" & _
        " and a.itm_cd = '" & lblItemCode.Caption & "'" & _
        " group by a.itm_cd, c.store_cd, d.op_dist_cd, d.store_name, d.sq_ft"
    Case 2
      .Clear
      .Rows = 2
      .Cols = 8
      .FormatString = "^SKU                                  |^QTY                   |^Size                           |^Color                           |^Store Code                 |^Store Name                     |^District Code          |^Square Footage       "
      strsql = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, a.store_cd, d.store_name, d.op_dist_cd, d.sq_ft" & _
        " from gm_inv_loc a, gm_sku b, gm_itm c, store d" & _
        " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And a.store_cd = d.store_cd" & _
        " and c.itm_cd = '" & lblItemCode.Caption & "' group by a.sku_num, b.size_cd, b.color_des, a.store_cd," & _
        " d.store_name , d.op_dist_cd, d.sq_ft order by a.store_cd, a.sku_num"
    Case 3
      .Clear
      .Rows = 2
      .Cols = 11
      .FormatString = "^PO#         |^Vendor Code          |^Factory Code     |^Status       |^On Order QTY  |^Ship Via    |^FOB            |^Order Date              |^Start Ship Date        |^ETA Date                |^PO Type         "
      strsql = "select distinct(a.po_num), a.ve_cd, a.fact_cd, a.stat_cd, sum(b.qty) qty," & _
        " a.ship_via, a.fob, a.ord_dt, a.do_not_ship_before_dt, a.ship_cmplt_dt, a.dist_method_cd" & _
        " from gm_po a, gm_po_ln b Where a.po_num = b.po_num and b.itm_cd = '" & lblItemCode.Caption & "'" & _
        " and a.stat_cd != 'CANC'" & _
        " group by  a.po_num, a.ve_cd, a.fact_cd, a.stat_cd, a.emp_init_buy," & _
        " a.ship_via, a.fob, a.ord_dt, a.do_not_ship_before_dt, a.ship_cmplt_dt, a.dist_method_cd"
    End Select
  
    Set rsmain = New ADODB.Recordset
    rsmain.Open strsql, cn, adOpenKeyset, adLockReadOnly
    If rsmain.EOF Then
      Select Case Index
      Case "bmnSize"
        MsgBox "This item does not have any current inventory information.", vbCritical, "No Total Inventory Records Found"
      Case "bmnStore"
        MsgBox "This item does not have any current location inventory records.", vbInformation, "No Location Inventory Records Found"
      Case "bmnSKU"
        MsgBox "This item does not have any current SKU/location inventory records.", vbInformation, "No SKU/Location Records Found."
      Case "bmnPO_Main"
        MsgBox "This item does not have any current PO records.", vbInformation, "No Current PO Records Found"
      End Select
    Else
      Do While Not rsmain.EOF()
            If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
        wasNull = False
        Select Case Index
        Case 0
          .TextMatrix(inti, 0) = rsmain("sku_num")
          .TextMatrix(inti, 1) = rsmain("qty")
          .TextMatrix(inti, 2) = IfNull(rsmain("size_cd"), wasNull, "")
          .TextMatrix(inti, 3) = IfNull(rsmain("color_des"), wasNull, "")
          .TextMatrix(inti, 4) = IfNull(rsmain("first_rcv_dt"), wasNull, "")
          .TextMatrix(inti, 5) = IfNull(rsmain("upc_cd"), wasNull, "")
        Case 1
          .TextMatrix(inti, 0) = rsmain("itm_cd")
          .TextMatrix(inti, 1) = IfNull(rsmain("qty"), wasNull, "")
          .TextMatrix(inti, 2) = IfNull(rsmain("store_cd"), wasNull, "")
          .TextMatrix(inti, 3) = IfNull(rsmain("op_dist_cd"), wasNull, "")
          .TextMatrix(inti, 4) = IfNull(rsmain("store_name"), wasNull, "")
          .TextMatrix(inti, 5) = IfNull(rsmain("sq_ft"), wasNull, "")
        Case 2
          .TextMatrix(inti, 0) = rsmain("sku_num")
          .TextMatrix(inti, 1) = rsmain("qty")
          .TextMatrix(inti, 2) = IfNull(rsmain("size_cd"), wasNull, "")
          .TextMatrix(inti, 3) = IfNull(rsmain("color_des"), wasNull, "")
          .TextMatrix(inti, 4) = IfNull(rsmain("store_cd"), wasNull, "")
          .TextMatrix(inti, 5) = IfNull(rsmain("store_name"), wasNull, "")
          .TextMatrix(inti, 6) = IfNull(rsmain("op_dist_cd"), wasNull, "")
          .TextMatrix(inti, 7) = IfNull(rsmain("sq_ft"), wasNull, "")
        Case 3
          .TextMatrix(inti, 0) = rsmain("po_num")
          .TextMatrix(inti, 1) = rsmain("ve_cd")
          .TextMatrix(inti, 2) = IfNull(rsmain("fact_cd"), wasNull, "")
          .TextMatrix(inti, 3) = IfNull(rsmain("stat_cd"), wasNull, "")
          .TextMatrix(inti, 4) = IfNull(rsmain("qty"), wasNull, "")
          .TextMatrix(inti, 5) = IfNull(rsmain("ship_via"), wasNull, "")
          .TextMatrix(inti, 6) = IfNull(rsmain("fob"), wasNull, "")
          .TextMatrix(inti, 7) = IfNull(rsmain("ord_dt"), wasNull, "")
          .TextMatrix(inti, 8) = IfNull(rsmain("do_not_ship_before_dt"), wasNull, "")
          .TextMatrix(inti, 9) = IfNull(rsmain("ship_cmplt_dt"), wasNull, "")
          .TextMatrix(inti, 10) = IfNull(rsmain("dist_method_cd"), wasNull, "")
        
        End Select
               For i = 1 To .Rows - 1 Step 2
                    .Row = i
                    For j = 0 To .Cols - 1
                        .Col = j
                        .CellBackColor = &HC0FFFF
                    Next j
 
        rsmain.MoveNext
  
      Loop
    End If
  End With
errhandler:
If Err Then
  MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical, "Error"
End If
End Sub

...could someone show me the best way to do this. Last time I tried to use the progress bar control I failed miserably (through no ones fault but my own), but I really want to get this control to work correctly in this application.

[Pradeep1210]

ProgressBar1.Min = 0
ProgressBar1.Max = 100
 
'Your Code
'
'
 
Do While Not rsmain.EOF()
    'Your Code
    ' 
    '
    ProgressBar1.Value = int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)
Loop

[dglienna]

I like this method:

http://www.vbforums.com/showthread.p...ht=progressbar

[Heprox]

This code:

ProgressBar1.Min = 0
ProgressBar1.Max = 100

'Your Code
'
'

Do While Not rsmain.EOF()
    'Your Code
    ' 
    '
    ProgressBar1.Value = int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)
Loop

...worked perfectly for what I wanted but I keep getting errors (Invalid property value) when the recordset is complete? When the last record is populated into the grid the error handler fires? The debugger comes back on the:

ProgressBar1.Value = int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)

[dglienna]

Slightly incorrect:

ProgressBar1.Value = int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)

should be

ProgressBar1.Value = int(rsmain.AbsolutePosition / rsmain.RecordCount) * 100

[Heprox]

I'm still getting the error even with:

ProgressBar1.Value = int(rsmain.AbsolutePosition / rsmain.RecordCount) * 100

I looked at the values that are being returned with:

Debug.Print Int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)

and noticed that the values are coming back as negatives, depending on the values entered by the user. It appears that the values are out of the range set for the progressbar?

[dglienna]

Print out the value for AbsolutePosition. I'm not sure if that is correct.

Didn't you see the link that i posted earlier? It has pretty good code that lets the actual query control the progressbar, so that you don't have to do anything once it is set up.

[Heprox]

I saw the code and would love to use it, but to be honest I'm confused in how to implement it correctly. I messed around with it forever and couldn't get it to work correctly. My skills with VB are primarily applications that deal with recordsets and database connections, this is the first time I've ever tried to use a Progress Bar.

The value for AbsolutePosition is "-3"

[Pradeep1210]

Are u using a server side cursor?? The code above will work only for client side cursors. For serverside cursors, the values of recordcount and absoluteposition are returned wrong.

Secondly, ain't these two statements the same (dglienna)?
ProgressBar1.Value = int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)

ProgressBar1.Value = int(rsmain.AbsolutePosition / rsmain.RecordCount) * 100

[Heprox]

How would I tell whether or not I'm using a server side cursor?

[dglienna]

They were reversed.

ProgressBar1.Value = int(rsmain.RecordCount * 100 / rsmain.AbsolutePosition )

[Pradeep1210]

In the debug window check "?rs.CursorLocation= adUseClient" is true or "?rs.CursorLocation= adUseServer" is true. Many a times if you set the cursor location from code but is not supported by the provider, they are reset by the provider.
In case it is a server side cursor, don't use absoluteposition property. Instead keep a counter in the loop and use that.
Sample Code:

Dim nCurrRec as long
ProgressBar1.Min = 0
ProgressBar1.Max = 100
 
'Your Code
'
'
nCurrRec = 0
Do While Not rsmain.EOF()
    'Your Code
    ' 
    '
    nCurrRec =nCurrRec +1
    ProgressBar1.Value = int(nCurrRec  * 100 / rsmain.RecordCount)
Loop

Edit: This code would work, whichever cursor you are working