I am not an advanced user, but manage to get around in VBA. A lot of thanks to the posts here. I am new to ADO and manage to be somewhat successful, until now. I have a workbook that I am using as a mini database as I prefer the functionality of Excel over Access for what I need to do. I posted code below, so let me explain what is going on. The 2 main routines are UpdateDept() and GetChartData(). Both are local to a specific worksheet - "Charts" - as if that matters. Anyhow, I have these routines called when there is a Worksheet_Change for specific cells. The UpdateDept() routine works without issues by itself, repeatedly. However, once I couple that with the GetChartData() routine, I run into issues. The UpdateDept() routine just updates ActiveX combo box lists based on certain criteria the user defines, like date ranges. Once they are updated, the user can choose from these drop down lists. I use ADO to grab a recordset from my stored data so I can “dynamically” create some charts based on the user selected criteria. Once I run the GetChartData() routine, the next Worksheet_Change event for specified target cells will call UpdateDept(). When trying to open the recordset, I get that Run-Time Error 3265. The weird thing is, that once I End, or Debug, the error, the next time a Worksheet_Change event occurs and calls UpdateDept() and GetChartData() routines, they work fine. But hen issue comes back repeatedly. I thought perhaps I was not closing the recordset, connection, or something. But that doesn’t appear to be it, at least from my limited ADO VBA coding experience. Sorry code is rudimentary.
Perhaps I have explained too much, or too little, but any help you can provide is most appreciated.
Code below.
‘////
Private Sub UpdateDept()
Dim StartDate, EndDate As Date
Dim a As Long
a = 0
StartDate = Range("E1")
EndDate = Range("E2")
'Updating Department Drop Down List based on selected criteria
strSQL = "Select Distinct [DEPARTMENT] From [Data$] WHERE [DATE ENTERED] >=#" & StartDate & "# AND [DATE ENTERED] <=#" & EndDate & "#"
If Range("E7") <> "ALL" Then
strSQL = strSQL & " AND [STATUS] = '" & Range("E7") & "'"
End If
If Range("E4") <> "All QC Errors" Then
strSQL = strSQL & " AND [INTERNAL or External] = '" & Range("E4") & "'"
End If
closeRS
OpenDB
cmbDepartment.Clear
rs.Open strSQL, cnn, adOpenKeyset, adLockPessimistic '<---- Error here
If rs.RecordCount > 0 Then
Do While Not rs.EOF
If a = 0 Then
cmbDepartment.AddItem "All Departments"
a = a + 1
rs.MoveNext
Else
cmbDepartment.AddItem rs.Fields(0)
rs.MoveNext
End If
Loop
Else
MsgBox "I was not able to find any unique Categories(s).", vbCritical + vbOKOnly
Exit Sub
End If
'Updating Customer Drop Down List based on selected criteria
a = 0
strSQL = "Select Distinct [CUSTOMER] From [Data$] WHERE [DATE ENTERED] >=#" & StartDate & "# AND [DATE ENTERED] <=#" & EndDate & "#"
If Range("E7") <> "ALL" Then
strSQL = strSQL & " AND [STATUS] = '" & Range("E7") & "'"
End If
If Range("E4") <> "All QC Errors" Then
strSQL = strSQL & " AND [INTERNAL or External] = '" & Range("E4") & "'"
End If
closeRS
OpenDB
cmbCustomer.Clear
rs.Open strSQL, cnn, adOpenKeyset, adLockPessimistic
If rs.RecordCount > 0 Then
Do While Not rs.EOF
If a = 0 Then
cmbCustomer.AddItem "All Customers"
a = a + 1
rs.MoveNext
Else
cmbCustomer.AddItem rs.Fields(0)
rs.MoveNext
End If
Loop
Else
MsgBox "I was not able to find any unique Categories(s).", vbCritical + vbOKOnly
Exit Sub
End If
'Updating Category Drop Down List based on selected criteria
a = 0
strSQL = "Select Distinct [ERROR CATEGORY] From [Data$] WHERE [DATE ENTERED] >=#" & StartDate & "# AND [DATE ENTERED] <=#" & EndDate & "#"
If Range("E7") <> "ALL" Then
strSQL = strSQL & " AND [STATUS] = '" & Range("E7") & "'"
End If
If Range("E4") <> "All QC Errors" Then
strSQL = strSQL & " AND [INTERNAL or External] = '" & Range("E4") & "'"
End If
closeRS
OpenDB
cmbCategory.Clear
rs.Open strSQL, cnn, adOpenKeyset, adLockPessimistic
If rs.RecordCount > 0 Then
Do While Not rs.EOF
If a = 0 Then
cmbCategory.AddItem "All Categories"
a = a + 1
rs.MoveNext
Else
cmbCategory.AddItem rs.Fields(0)
rs.MoveNext
End If
Loop
Else
MsgBox "I was not able to find any unique Categories(s).", vbCritical + vbOKOnly
Exit Sub
End If
'Updating Press Drop Down List based on selected criteria
a = 0
strSQL = "Select Distinct [PRESS] From [Data$] WHERE [DATE ENTERED] >=#" & StartDate & "# AND [DATE ENTERED] <=#" & EndDate & "#"
If Range("E7") <> "ALL" Then
strSQL = strSQL & " AND [STATUS] = '" & Range("E7") & "'"
End If
If Range("E4") <> "All QC Errors" Then
strSQL = strSQL & " AND [INTERNAL or External] = '" & Range("E4") & "'"
End If
closeRS
OpenDB
cmbPress.Clear
rs.Open strSQL, cnn, adOpenKeyset, adLockPessimistic
If rs.RecordCount > 0 Then
Do While Not rs.EOF
If a = 0 Then
cmbPress.AddItem "All Presses"
a = a + 1
rs.MoveNext
Else
cmbPress.AddItem rs.Fields(0)
rs.MoveNext
End If
Loop
Else
MsgBox "I was not able to find any unique Categories(s).", vbCritical + vbOKOnly
Exit Sub
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, [E1,E2,E4,E7]) Is Nothing Then Exit Sub
UpdateDept
GetChartData
End Sub
Private Sub GetChartData()
Dim a, b As Long
Dim ChartCat As String
Dim CountCost As String
Dim DepPressCat As String
Dim StartDate, EndDate As Date
StartDate = Range("E1")
EndDate = Range("E2")
If Range("E5") <> "NonConformance" Then
ChartCat = Range("E5")
If ChartCat = "Department" Then
cmbDepartment.Clear
Else
cmbPress.Clear
End If
Else
ChartCat = "Error Category"
cmbCategory.Clear
End If
If Range("E6") = "Count" Then
CountCost = "Count([$ AMOUNT]) "
Else
CountCost = "Sum([$ AMOUNT])"
End If
strSQL = "SELECT distinct [" & ChartCat & "], " & CountCost & " as total " & _
"FROM [Data$] WHERE [DATE ENTERED] >=#" & StartDate & "# AND [DATE ENTERED] <=#" & EndDate & "#"
If Range("E4") <> "All QC Errors" Then
strSQL = strSQL & " AND [INTERNAL or External] = '" & Range("E4") & "'"
End If
If Range("E7") <> "ALL" Then
strSQL = strSQL & " AND [STATUS] = '" & Range("E7") & "'"
End If
If ChartCat = "Department" Then
If Range("H5") <> "" And Range("H5") <> "All Presses" Then DepPressCat = " AND [PRESS] = '" & Range("H5") & "'"
If Range("H7") <> "" And Range("H7") <> "All Categories" Then DepPressCat = DepPressCat & " AND [ERROR CATEGORY] = '" & Range("H7") & "'"
ElseIf ChartCat = "Press" Then
If Range("H4") <> "" And Range("H4") <> "All Departments" Then DepPressCat = " AND [DEPARTMENT] = '" & Range("H4") & "'"
If Range("H7") <> "" And Range("H7") <> "All Categories" Then DepPressCat = DepPressCat & " AND [ERROR CATEGORY] = '" & Range("H7") & "'"
ElseIf ChartCat = "Error Category" Then
If Range("H4") <> "" And Range("H4") <> "All Departments" Then DepPressCat = " AND [DEPARTMENT] = '" & Range("H4") & "'"
If Range("H5") <> "" And Range("H5") <> "All Presses" Then DepPressCat = " AND [PRESS] = '" & Range("H5") & "'"
End If
strSQL = strSQL & DepPressCat & " GROUP BY [" & ChartCat & "]"
'now extract data
closeRS
OpenDB
rs.Open strSQL, cnn, adOpenKeyset, adLockPessimistic
If rs.RecordCount > 0 Then
Sheets("Charts").Visible = True
Sheets("Charts").Select
Range("chartdataSet").Select
Range(Selection, Selection.End(xlDown)).ClearContents
'Now putting the data on the sheet
rs.Sort = "total DESC"
ActiveCell.CopyFromRecordset rs
Else
MsgBox "I was not able to find any matching records.", vbExclamation + vbOKOnly
Exit Sub
End If
Range("E2").Select
closeRS
cnn.Close
End Sub
‘////
