The following code works very well without the lines.
Code: Select all
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.EnableEvents = True
Application.ScreenUpdating = True
But when the screen updating lines are put in the code it does not work once it gives the message "no records". However it works each time the user writes a value that exists in the database.
How could I overcome this?
Code: Select all
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim strConn As String
Dim strSQL As String
Dim ce As Range
Dim rCell As Range
If Not Intersect(Range("L9"), Target) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("E18:E53,F18:O53,O7,O9,O15,H7,H9,H11,H15,U5,L11,L13,L15,T3,T7,T9,T11").ClearContents
If Range("L9").Value <> "" Then
Set cnn = New ADODB.Connection
strConn = "provider=sqloledb.1;data source=ABCD;" & _
"user id=adam;password=adam2;initial catalog = MyDatabase"
cnn.Open ConnectionString:=strConn
Set rst = New ADODB.Recordset
strSQL = "SELECT [Code] FROM Csh WHERE [BillNo]=" & Range("L9").Value
rst.Open Source:=strSQL, ActiveConnection:=cnn, Options:=adCmdText
If rst.EOF And rst.BOF Then
MsgBox "No Records!", vbCritical, "No Records"
Range("L9").Value = ""
Exit Sub
End If
Range("E18").CopyFromRecordset rst
rst.Close
strSQL = "SELECT [ID] FROM table1 WHERE [Index]=" & Range("O9").Value
rst.Open Source:=strSQL, ActiveConnection:=cnn, Options:=adCmdText
Range("H7").Value = rst![ID]
rst.Close
For Each ce In Range("E18:E53")
If ce.Value <> "" Then
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ace.OLEDB.12.0; " & _
"Data Source=E:\folder\ Database.accdb;"
rst.Open Source:="SELECT [Code] from Table2 WHERE [ Codes]= " & ce.Value, _
ActiveConnection:=cnn, CursorType:=adOpenStatic, Options:=adCmdText
If Not rst.EOF Then
ce.Offset(0, 1).Value = rst.Fields("Code")
End If
rst.Close
End If
Next ce
cnn.Close
End If
For Each rCell In Range("E18:E53")
If rCell <> "" Then rCell.EntireRow.Hidden = False
Next rCell
Set rst = Nothing
Set cnn = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub