Solved

AVOID WORKSHEET CHANGE VBA WHEN QUERY REFRESH

Posted on 2011-02-21
13
665 Views
Last Modified: 2012-05-11
Hi,

I have the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
  i = Target.Row
    If Intersect(Target, Range("celdas")) Is Nothing Then Exit Sub
         Range("AG" & i).Value = "x"
     If Target.Count > 1 Then
Range("AG" & i & ":" & "AG" & i + Target.Count).FillDown
End If
End Sub

Open in new window


The problem is that the Worksheet is used as an interface to retrieve, modify and update data in a SQL database. (Only the rows that contain an X in column AG)
This part of the code just will add an "x" in the row where the user is doing a change in the fields that will be updated (Named Range: celdas)

I don't know why When the query is refreshed the complete AG column appears with an X in the cells...
Is crazy but is happening only in one of the files (I have three other files with the same code and nothing happens when the query is refreshed).

Maybe there is a "before query refresh code" that could stop the code I posted to run while refreshing ?...or there is any other way to avoid this issue ?

Any help is really appreciated.

Thank you for your time.
Roberto.
0
Comment
Question by:Pabilio
  • 6
  • 5
  • 2
13 Comments
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 34942942
Are you refreshing the query in code or manually? If in code, you can use
Application.EnableEvents = False
' code to refresh
Application.EnableEvents = True

Open in new window


If manually, you'll need a class - see my sample here: http:/Q_26830874.html
0
 
LVL 30

Assisted Solution

by:SiddharthRout
SiddharthRout earned 100 total points
ID: 34942945
What happens when you try this?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    i = Target.Row
    If Not Intersect(Target, Range("celdas")) Is Nothing Then
        Application.EnableEvents = False
        Range("AG" & i).Value = "x"
        If Target.Count > 1 Then _
        Range("AG" & i & ":" & "AG" & i + Target.Count).FillDown
        Application.EnableEvents = True
    End If
End Sub

Open in new window


Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34942953
>>> Speedy Rorya at work :) Beaten again...

Sid
0
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 400 total points
ID: 34942967
FYI, if you are using the class, the code for your version would be more like:
Option Explicit

Private WithEvents qt As QueryTable

Private Sub qt_AfterRefresh(ByVal Success As Boolean)
   Application.EnableEvents = True
End Sub

Private Sub qt_BeforeRefresh(Cancel As Boolean)
   Application.EnableEvents = False
End Sub

Private Sub Worksheet_Activate()
   hookqt
End Sub
Public Sub hookqt()
   Set qt = Me.ListObjects(1).QueryTable
End Sub

Open in new window

0
 
LVL 5

Author Comment

by:Pabilio
ID: 34943247
Dear Rory and Syd,

Thank you very much for your help here....

The query could be refreshed both ways: manually and code.

I tried the application enable events to fix the code but without success...this is what I did:

Private Sub CommandButton5_Click()
    Me.Hide

Application.EnableEvents = False
    ActiveWorkbook.RefreshAll
Application.EnableEvents = True
    
 MsgBox Prompt:="EL CONTROL HA SIDO ACTUALIZADO", Title:="ACTUALIZACION COMPLETA"
Continuar = False
 End Sub

Open in new window


and also  tried the code posted by Syd:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    i = Target.Row
    If Not Intersect(Target, Range("celdas")) Is Nothing Then
        Application.EnableEvents = False
        Range("AG" & i).Value = "x"
        If Target.Count > 1 Then _
        Range("AG" & i & ":" & "AG" & i + Target.Count).FillDown
        Application.EnableEvents = True
    End If
End Sub

Open in new window


Also with no results... (Column AG have the X in all cells).

I tried the class (I never worked whit class modules before) but I thnik is to add a new class module and copy Rorya's code:
Option Explicit

Private WithEvents qt As QueryTable

Private Sub qt_AfterRefresh(ByVal Success As Boolean)
   Application.EnableEvents = True
End Sub

Private Sub qt_BeforeRefresh(Cancel As Boolean)
   Application.EnableEvents = False
End Sub

Private Sub Worksheet_Activate()
   hookqt
End Sub
Public Sub hookqt()
   Set qt = Me.ListObjects(1).QueryTable
End Sub

Open in new window


And the problem persists... MORe than probably there is something wrong I'm doing here...

Any ideas ?

Thank you for your time.
Roberto.
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 34943318
The code I mentioned should go into the code module for the sheet containing the querytable.
If you are refreshing on code, then either:
1. do not use RefreshAll - loop through the sheets and refresh each table and specify the Backgroundquery:=False argument; or
2. In the table properties for the query table on the sheet turn off the option to refresh in the background.
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 5

Author Comment

by:Pabilio
ID: 34944104
Rorya,

This thing is driving me crazy...

Here is the complete sheet module after inserting your class code in it:

Option Explicit

Private WithEvents qt As QueryTable

Private Sub qt_AfterRefresh(ByVal Success As Boolean)
   Application.EnableEvents = True
End Sub

Private Sub qt_BeforeRefresh(Cancel As Boolean)
   Application.EnableEvents = False
End Sub

Private Sub Worksheet_Activate()
   hookqt
End Sub
Public Sub hookqt()
   Set qt = Me.ListObjects(1).QueryTable
End Sub

Private Sub CommandButton1_Click()
UserForm2.Show
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     Dim lngRow As Long
     Dim F
    F = Sheets("PRINT").Cells(1, 8).Value
     'Limit Target count to 1
    If Target.Count > 1 Then Exit Sub
     'Isolate Target to a specific range
    If Intersect(Target, Range("tildes")) Is Nothing Then Exit Sub
    lngRow = Target.Row
     'set Target font tp "marlett"
    Target.Font.Name = "marlett"
     'Check value of target
    If Target.Value <> "1" Then
        Target.Value = "1" 'Sets target Value = "a"
        ' check it's column B
        If Target.Column = 3 Then
        With Sheets("CONTROL GENERAL")
        .Cells(lngRow, "B").Value = Sheets("PRINT").Cells(1, "H").Value
        End With
        With Sheets("PRINT")
            .Cells(4, "B").Value = Cells(lngRow, "S").Value
            .Cells(5, "B").Value = Cells(lngRow, "R").Value
            .Cells(6, "B").Value = Cells(lngRow, "U").Value
            .Cells(7, "B").Value = Cells(lngRow, "H").Value
            .Cells(1, "E").Value = Cells(lngRow, "A").Value
            .PrintOut From:=1, To:=1, Copies:=1, _
        ActivePrinter:="HP LaserJet 1220 Series PCL (Copiar 1) en Ne00:", Collate:= _
        True
            .Cells(4, "B").Resize(4).ClearContents
            .Cells(1, 8).Value = Sheets("PRINT").Cells(1, 8).Value + 1
            
        End With
        Workbooks.Open Filename:= _
 "\\Servidor\D\CONTROLES NUEVOS SEGUNDA VERSION\PINTURA.xls"
             
             With Workbooks("PINTURA.XLS").Sheets(1)
            Dim hoy
           hoy = Now
           
          lngNextHistRow = .Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
         .Cells(lngNextHistRow, "A").Value = Cells(lngRow, "B").Value
         .Cells(lngNextHistRow, "H").Value = i
         .Cells(lngNextHistRow, "I").Value = Cells(lngRow, "S").Value
         .Cells(lngNextHistRow, "J").Value = Cells(lngRow, "O").Value
         .Cells(lngNextHistRow, "K").Value = Cells(lngRow, "R").Value
         .Cells(lngNextHistRow, "L").Value = Cells(lngRow, "U").Value
         .Cells(lngNextHistRow, "M").Value = Cells(lngRow, "H").Value
         .Cells(lngNextHistRow, "N").Value = Cells(lngRow, "A").Value
         .Cells(lngNextHistRow, "O").Value = hoy
         .Cells(1, 25).Value = F
     ActiveWorkbook.Save
    ActiveWindow.Close
End With
        
        
        End If
        Cancel = True
        Exit Sub
    End If
    If Target.Value = "1" Then
        Target.ClearContents 'Sets Target Value = ""
        Cancel = True
        Exit Sub
    End If
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
  'Limit Target count to 1
 Dim i As Long
    i = Target.Row
    If Intersect(Target, Range("cambios")) Is Nothing Then Exit Sub
         Range("AG" & i).Value = "x"
     If Target.Count > 1 Then
Range("AG" & i & ":" & "AG" & i + Target.Count).FillDown
End If
End Sub
 

Open in new window


In the last piece of code I had to add the line: Dim i as long after copiying your code in the module (error: variable not defined)...before that It run without that line.

But anyway the X's are still apearing in the whole AG column when refreshing the query.

If I switch between sheets of the same workbook then I got an error 9 when returning to sheet1 (where the query is)... subindex out of interval.
Highligthed:

More than crazy is that when I open another workbook which have the same code and conditions (querys and codes) and it works fine, then BOTH files works fine !!....
If I close the good file, then the problematic one starts the X´s problem again...

I'm going to start criying here...

Thank you for your time,
Roberto.
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 34944172
If you are using a version earlier than 2007, then change the hookqt sub (lines 16-18) to:
Public Sub hookqt()
   Set qt = Me.QueryTables(1)
End Sub

Open in new window

0
 
LVL 5

Author Comment

by:Pabilio
ID: 34944378
Now when switching sheets the error does not shows again...
but then when doing a change the X is not showed...
I give up...
I'm going to start from zero the file...
It looks like something is corrupted there.
Thank you rorya.
Roberto.
0
 
LVL 5

Author Comment

by:Pabilio
ID: 35110835
Hi Rorya and Sid,

I forgot to close this question...
Actually , after doing a new workbook your recomendations worked perfectly...

Thanks again,
Roberto.

P.S. Rorya, I tried to contact you trough the Hire me Button for a small project for my Furniture Factory... Did you received the email or notification ?...
As it was during EE updating it's database and I had a TERRIBLE conection where I'm right now which come and goes as it likes... I don't know if you didn't receive it or you are not interested. (I understand perfectly if you don't :-)
0
 
LVL 5

Author Closing Comment

by:Pabilio
ID: 35110848
Thank you for your time and I'm sorry for the delay closing the question.
Roberto.
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35112670
Roberto,
I haven't seen anything, but it might be down to my spam filter (it gets a bit over zealous sometimes). Feel free to send it again, though I am quite busy at the moment so I can't promise anything.
Rory
0
 
LVL 5

Author Comment

by:Pabilio
ID: 35112924
Rory,
Done... I already send you again the info.
Thank you for your time.
Roberto.
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now