[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 739
  • Last Modified:

AVOID WORKSHEET CHANGE VBA WHEN QUERY REFRESH

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
Pabilio
Asked:
Pabilio
  • 6
  • 5
  • 2
2 Solutions
 
Rory ArchibaldCommented:
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
 
SiddharthRoutCommented:
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
 
SiddharthRoutCommented:
>>> Speedy Rorya at work :) Beaten again...

Sid
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
Rory ArchibaldCommented:
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
 
PabilioAuthor Commented:
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
 
Rory ArchibaldCommented:
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
 
PabilioAuthor Commented:
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
 
Rory ArchibaldCommented:
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
 
PabilioAuthor Commented:
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
 
PabilioAuthor Commented:
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
 
PabilioAuthor Commented:
Thank you for your time and I'm sorry for the delay closing the question.
Roberto.
0
 
Rory ArchibaldCommented:
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
 
PabilioAuthor Commented:
Rory,
Done... I already send you again the info.
Thank you for your time.
Roberto.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 6
  • 5
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now