Screen Updating

User avatar
adam
SilverLounger
Posts: 2347
Joined: 23 Feb 2010, 12:07

Screen Updating

Post by adam »

Hi anyone,

The following code works very well without the lines.

Code: Select all

        Application.ScreenUpdating = False
        Application.EnableEvents = False

        Application.EnableEvents = True
        Application.ScreenUpdating = True
When the user writes a value cell L9, the code gets relevant data from the database to the excel sheet. And if the user writes a value that does not exist in the database it gives the user a message saying there’s no record.

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
Any help on this would be kindly appreciated.
Best Regards,
Adam

User avatar
HansV
Administrator
Posts: 78393
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Screen Updating

Post by HansV »

After displaying the message box "No records!", you exit the procedure. So Application.EnableEvents remains turned off instead of being set to True again. After that, the Worksheet_Change event will be ignored.
Best wishes,
Hans

User avatar
adam
SilverLounger
Posts: 2347
Joined: 23 Feb 2010, 12:07

Re: Screen Updating

Post by adam »

You mean it should be as follows?

Code: Select all

If rst.EOF And rst.BOF Then
    MsgBox "No Records!", vbCritical, "No Records"
    Range("L9").Value = ""
    Application.EnableEvents = TRUE
    Application.ScreenUpdating = TRUE
    Exit Sub
End If
Best Regards,
Adam

User avatar
HansV
Administrator
Posts: 78393
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Screen Updating

Post by HansV »

Yes.
Best wishes,
Hans

User avatar
adam
SilverLounger
Posts: 2347
Joined: 23 Feb 2010, 12:07

Re: Screen Updating

Post by adam »

Thankyou very much Hans.
Best Regards,
Adam

User avatar
StuartR
Administrator
Posts: 12601
Joined: 16 Jan 2010, 15:49
Location: London, Europe

Re: Screen Updating

Post by StuartR »

It would be better to replace

Code: Select all

If rst.EOF And rst.BOF Then
    MsgBox "No Records!", vbCritical, "No Records"
    Range("L9").Value = ""
    Exit Sub
End If
With

Code: Select all

If rst.EOF And rst.BOF Then
    MsgBox "No Records!", vbCritical, "No Records"
    Range("L9").Value = ""
Else
And then add a final End If near the end of the routine, just before you clear everything up.
StuartR