help with code used to update multiple records from datagrid 1

[kskinne]

I have the following code in a VB6 project, which is used to update certain fields within selected rows within a datagrid tied to an ADO recordset. We are running into issues where this code seems to run very slowly, taking several seconds just to update one of the records. Does anyone see any issues with this code that would cause it to not run efficiently? Or any suggestions on how to make it run more quickly? One more thing to add, it seems to run slower when there are more results in the data grid, but even when it runs slowly, there are not that many more records. For example it will run very fast when a couple records are updated in a data grid with 50 rows, but will run very slowly in a data grid with 140 rows. Here is the code:

Private Sub cmdMarkSelected_Click()
10    On Error GoTo cmdMarkSelected_Click_Error
20    If cboMarkAs.Text = "" Then
30      MsgBox "You must select the item to be marked as either Paid or Unpaid.", vbCritical, "Paid or Unpaid?"
40      cboMarkAs.SetFocus
50      Exit Sub
60    End If
      Dim i As Integer ' Counter
      Dim cID As Long
      Dim intCount As Integer
      Dim iRet As String
70    intCount = DataGrid2.SelBookmarks.Count - 1
80    If intCount > -1 Then
90      iRet = MsgBox("Mark selected item commissions as " & UCase(cboMarkAs.Text) & "?", vbYesNo, "Mark as " & UCase(cboMarkAs.Text))
100     If iRet = vbYes Then 'Yes mark as either Paid or Unpaid depending on the selection made in the form
110       ReDim arrselbk(intCount) 'Declare array to hold bookmarks.
120       For i = 0 To intCount
130         arrselbk(i) = DataGrid2.SelBookmarks(i)
            'MsgBox ("array bookmark " + Str(i))
140       Next i
          'MsgBox ("Intcount " + Str(intCount))
150       i = i - 1
160       Do While i > -1
            'MsgBox (Str(i))
            'MsgBox (Str(arrselbk(i)))
170         cID = DataGrid2.Columns(7).CellValue(arrselbk(i))
            'MsgBox (Str(cID)) '
180         Adodc3.ConnectionString = glbStrConnect
190         Adodc3.RecordSource = "SELECT paid, datePaid, comment FROM c_CommPaid WHERE ID = " + Str(cID)
200         Adodc3.Refresh
210         If Adodc3.Recordset.RecordCount > 0 Then
220           If cboMarkAs.Text = "Paid" Then
230             Adodc3.Recordset.Fields(2).Value = Trim$(txtComment.Text)
240             Adodc3.Recordset.Fields(1).Value = dtSetPaidDate.Value
250             Adodc3.Recordset.Fields(0).Value = 1
260             Adodc3.Recordset.Update
270           Else
280             Adodc3.Recordset.Fields(2).Value = Trim$(txtComment.Text)
290             Adodc3.Recordset.Fields(1).Value = "1905-06-22 00:00:00.000"
300             Adodc3.Recordset.Fields(0).Value = 0
310             Adodc3.Recordset.Update
320           End If
330           Adodc2.Refresh
340         End If
350         i = i - 1
360       Loop
370     Call Format_DataGrid2
380     End If
390   Else
400     MsgBox "There Are No Items Marked.", vbCritical, "No Items Marked"
410   End If
420   On Error GoTo 0
430   Exit Sub
cmdMarkSelected_Click_Error:
440   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdMarkSelected_Click of Form frmCommPaid - Error on Line number: " & Erl
End Sub

Thank you,
Kevin

 

[Andrzejek]

I would be very tempted to try this:

i = i - 1
[blue]
Adodc3.ConnectionString = glbStrConnect
Adodc3.RecordSource = "SELECT paid, datePaid, comment, ID FROM c_CommPaid"
[/blue]
Do While i > -1
  cID = DataGrid2.Columns(7).CellValue(arrselbk(i))[blue]
  Adodc3.Recordset.Filter = "ID = " & Str(cID)[/blue]
  Adodc3.Refresh
  If Adodc3.Recordset.RecordCount > 0 Then
    If cboMarkAs.Text = "Paid" Then
      Adodc3.Recordset.Fields(2).Value = Trim$(txtComment.Text)
      Adodc3.Recordset.Fields(1).Value = dtSetPaidDate.Value
      Adodc3.Recordset.Fields(0).Value = 1
      Adodc3.Recordset.Update
    Else
      Adodc3.Recordset.Fields(2).Value = Trim$(txtComment.Text)
      Adodc3.Recordset.Fields(1).Value = "1905-06-22 00:00:00.000"
      Adodc3.Recordset.Fields(0).Value = 0
      Adodc3.Recordset.Update
    End If
    Adodc2.Refresh
  End If
  i = i - 1
Loop

---- Andy

There is a great need for a sarcasm font.

 

[kskinne]

Thanks Andy - when I run the code you supplied above, I am getting runtime error on the line "Adodc3.Recordset.Filter = "ID = " & Str(cID)". The error message is "error 91 (object variable or with block variable not set)"

What variable is not declared?

I changed that line from "Adodc.Recordset.Filter = "ID = " & Str(cID)" to "Adodc3.Recordset.Filter = "ID = " & Str(cID)"

Thank you,
Kevin

 

[kskinne]

I did actually update that line, but I am still getting the run time error I referenced in my reply above.

Thanks,
Kevin

 

[Andrzejek]

[tt]Str[/tt] is not declared anywhere that I can see.
Did you declared it some place else?

Do you have [tt]Option Explicit[/tt] at the top of your code?

You may just try:
[tt]Adodc3.Recordset.Filter = "ID = " & [blue]cID[/blue]
[/tt]
Since you get your ID from your grid...

---- Andy

There is a great need for a sarcasm font.

 

[kskinne]

Andy I do have Option Explicit included in my code, but even if I leave this out, I still get the same error message on that line. And I get that same message whether I use "Adodc3.Recordset.Filter = "ID = " & cID" or "Adodc3.Recordset.Filter = "ID = " & Str(cID)"?

 

[Andrzejek]

So I would try:
Debug.Print "ID = " & cID
or
Debug.Print "ID = " & Str(cID)

And ADODC should have FILTER method.


---- Andy

There is a great need for a sarcasm font.

 

[kskinne]

Andy what data type should I use to declare Str? If I add a declaration for Str without assigning as a specific data type, then I get a type mismatch error on that line "Adodc3.Recordset.Filter = "ID = " & Str(cID)

 

[Andrzejek]

Turns out, [tt]Str[/tt] is a VBA function that returns a Variant (String) representation of a number.
I don't think you need to use it because (I assume) yout ID field in your c_CommPaid table is a number, and you keep that number in your 7th (?) column in your grid.
So it does not make sense to have a number, convert it to a String and use it as a number again.

Could you post your code as you have now? Even if it does not work.

When you type in your code:[tt]
Adodc3.Recordset.[/tt]
do you have a [tt]Filter[/tt] option in the intelisense in VBA?


---- Andy

There is a great need for a sarcasm font.

 

[kskinne]

Hi Andy - I'll be honest, trying to declare that string function as a variable did have me scratching my head. You are correct, the ID is a long integer, and it is in the 7th column of the data grid. I have removed the str function from the line of code, and here is my code as I have it now:

Private Sub cmdMarkSelected_Click()
10    On Error GoTo cmdMarkSelected_Click_Error
20    If cboMarkAs.Text = "" Then
30      MsgBox "You must select the item to be marked as either Paid or Unpaid.", vbCritical, "Paid or Unpaid?"
40      cboMarkAs.SetFocus
50      Exit Sub
60    End If
      Dim i As Integer ' Counter
      Dim cID As Long
      Dim intCount As Integer
      Dim iRet As String
70    intCount = DataGrid2.SelBookmarks.Count - 1
80    If intCount > -1 Then
90      iRet = MsgBox("Mark selected item commissions as " & UCase(cboMarkAs.Text) & "?", vbYesNo, "Mark as " & UCase(cboMarkAs.Text))
100     If iRet = vbYes Then 'Yes mark as either Paid or Unpaid depending on the selection made in the form
110       ReDim arrselbk(intCount) 'Declare array to hold bookmarks.
120       For i = 0 To intCount
130         arrselbk(i) = DataGrid2.SelBookmarks(i)
140       Next i
150       i = i - 1
160       Adodc3.ConnectionString = glbStrConnect
170       Adodc3.RecordSource = "SELECT paid, datePaid, comment, ID FROM c_CommPaid"
180       Do While i > -1
190         cID = DataGrid2.Columns(7).CellValue(arrselbk(i))
200         Adodc3.Recordset.Filter = "ID = " & cID
210         Adodc3.Refresh
220         If Adodc3.Recordset.RecordCount > 0 Then
230           If cboMarkAs.Text = "Paid" Then
240             Adodc3.Recordset.Fields(2).Value = Trim$(txtComment.Text)
250             Adodc3.Recordset.Fields(1).Value = dtSetPaidDate.Value
260             Adodc3.Recordset.Fields(0).Value = 1
270             Adodc3.Recordset.Update
280           Else
290             Adodc3.Recordset.Fields(2).Value = Trim$(txtComment.Text)
300             Adodc3.Recordset.Fields(1).Value = "1905-06-22 00:00:00.000"
310             Adodc3.Recordset.Fields(0).Value = 0
320             Adodc3.Recordset.Update
330           End If
340         End If
350         i = i - 1
360       Loop
370     Adodc2.Refresh
380     Call Format_DataGrid2
390     End If
400   Else
410     MsgBox "There Are No Items Marked.", vbCritical, "No Items Marked"
420   End If
430   On Error GoTo 0
440   Exit Sub
cmdMarkSelected_Click_Error:
450   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdMarkSelected_Click of Form frmCommPaid - Error on Line number: " & Erl
End Sub

Thanks,
Kevin

 

[Andrzejek]

You did not answer this question:
When you type in your code:[tt]
Adodc3.Recordset.[/tt]
do you have a [tt]Filter[/tt] option in the intelisense in VBA?

I start to question if ADODC has a Filter method...

And - what do you get in a message box if you do this:

cID = DataGrid2.Columns(7).CellValue(arrselbk(i))[blue]
MsgBox "ID = " & cID[/blue]
Adodc3.Recordset.Filter = "ID = " & cID

---- Andy

There is a great need for a sarcasm font.

 

[kskinne]

Sorry I missed that piece - when I type 'adodc3.recordset.', I am able to select 'Filter' from the intellisense drop down list.

When I insert the msgbox line in the code, i get 'ID = 46942', 46942 is the ID in the database for the first record I had selected in the data grid.

 

[Andrzejek]

So we do have Filter (which is great), and looks like the Filter should work.
Do you get this error when you run the code and your run stops at the [tt]Adodc3.Recordset.Filter = "ID = " & cID [/tt] line?
Or, do you do Start with full compile and that's when you get the error?


---- Andy

There is a great need for a sarcasm font.

 

[kskinne]

I do not get the error when I compile the code, I am just running the code from within my project, and at runtime I am getting error on the 'Adodc3.Recordset.Filter = "ID = " & cID line'. When I compile the code I do not receive a compile error, however I get the same runtime error when I run the exe application.

Thanks,
Kevin

 

[kskinne]

If I start from within the project with full compile (ctrl+F5), the same thing happens, I get the error at run time when it gets to that line I mentioned above.

 

[Andrzejek]

This is confusing...
You start your computer.
You open your VB6 application in design mode.
You hit Ctrl-F5.
Before you click anything else, select anything else, do anything else - do you get the error?


---- Andy

There is a great need for a sarcasm font.

 

[kskinne]

No, I do not. When I do what you mentioned above, my program opens, and then in my form I select the records and click the command button in my program that triggers this procedure to run, and that is when I get the runtime error.

 

[Andrzejek]

Now we know your code compiles. That's nice.
So next step I would try is to hatd-code the ID value in your Filter line just to see if that will even work:

Adodc3.Recordset.Filter = [blue]"ID = 46942"[/blue]

---- Andy

There is a great need for a sarcasm font.

 

[kskinne]

Andy, I used this line of code Adodc3.Recordset.Filter = "ID = 46942" and still got the same error on this same line

 

[kskinne]

Andy, I was wondering if that error was happening because my recordset I'm trying filter wasn't set to anything. So I decided to try inserting a new line of code:

Adodc3.Refresh

right after the line of code Adodc3.RecordSource = "SELECT paid, datePaid, comment, ID FROM c_CommPaid"

Now with this additional line of code, I am not getting that runtime error message, or any other error message, however it is not updating my selected data.