Code copying data before query has refreshed

[Bagsy]

I wonder if anybody could just look at my code. (MS Office 365)

I am copying data from a sheet that runs a query (which was created by somebody else). Everything works great except when I come to copy the column of data I require it always copies before the sheet is refreshed, regardless of any wait time I set. I have timed how long it take to refresh and it was around 18 secs. I have set my wait time up to 60 secs and it still does not work.

When I run to a break point at (WB1.Activate) I look at the workbook I am copying from and I can see the copy dotted lines around the column, then I see the sheet refresh and the data change, so its copying before the data has refreshed, I wonder if my line of code for refreshing the query is correct.

Any help is appreciated

Sub CheckIfDispatched()

Dim WB1 As Workbook
Dim WB2 As Workbook

'Application.ScreenUpdating = False
'Application.DisplayAlerts = False

' Capture current workbook
Set WB1 = ActiveWorkbook

'***************************************

Dim a As Integer
a = Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Range("E2:E" & a).ClearContents

'***************************************

' Opening the Open SO Items register
Workbooks.Open Filename:="L:\EMAX\EMAX REPORTS\Open SO Items.xlsx", ReadOnly:=True

' Capture new workbook
Set WB2 = ActiveWorkbook
Sheets("Open SO Items").Select
Sheets("Open SO Items").ShowAllData 'Clear All Filters for entire Table
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=True
'ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:60"))

'***************************************

'Copying the SO numbers
a = Sheets("Open SO Items").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Open SO Items").Range("A2:A" & a).Copy

'***************************************

' Go back to original workbook
WB1.Activate
'Pasting the SO numbers
Sheets("Sheet2").Range("E2").PasteSpecial xlPasteValues
Application.CutCopyMode = False

'**************************************

'comparing SO numbers, to see if the SO number is still on the open SO items register, otherwise it may have been cancelled or dispatched
Dim Cl As Range
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")

With Sheets("Sheet2")
For Each Cl In .Range("E2", .Range("E" & Rows.Count).End(xlUp))
Dic(Cl.Value) = Array(Cl, Cl.Offset(, 1).Value)
Next Cl
End With

With Sheets("Sheet1")
For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
If Not Dic.Exists(Cl.Value) Then
Cl.Offset(0, 1).Interior.Color = vbGreen
End If

Next Cl

End With
WB2.Close False ' closing the Open SO items register
'Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[Bagsy]

Can anybody offer any advice on this please

 

[Bagsy]

In case this is any help to anyone I have managed to solve the problem regarding refreshing the query, with a great deal of searching. I changed this line

Selection.ListObject.QueryTable.Refresh BackgroundQuery:=True

To

Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

I'm not sure what the True & False parts of the refresh actually do but it worked ok. Full code below in case it helps anyone

Sub CheckIfDispatched()
    Dim WB1 As Workbook
    Dim WB2 As Workbook
    Application.ScreenUpdating = False
    
'   Capture current workbook
    Set WB1 = ActiveWorkbook

    '***************************************
    Dim a As Integer   'Clearing old data from sheet 2 of the cert pack tracker workbook
    a = Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Row
    Sheets("Sheet2").Range("E2:E" & a).ClearContents
    
    '***************************************
'   Opening the Open SO Items register
    Workbooks.Open Filename:="L:\EMAX\EMAX REPORTS\Open SO Items.xlsx", ReadOnly:=True

'   Capture new workbook
    Set WB2 = ActiveWorkbook
            Sheets("Open SO Items").Select
        Sheets("Open SO Items").ShowAllData 'Clear All Filters for entire Table
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    
  '***************************************
    'Copying the SO numbers
    a = Sheets("Open SO Items").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Open SO Items").Range("A2:A" & a).Copy
    
   '***************************************
    '   Go back to original workbook
    WB1.Activate
    'Pasting the SO numbers
    Sheets("Sheet2").Range("E2").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    '**************************************
    'comparing SO numbers, to see if the SO number is still on the open SO items register, otherwise it may have been cancelled or dispatched
    Dim Cl As Range
    Dim Dic As Object

    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet2")
        For Each Cl In .Range("E2", .Range("E" & Rows.Count).End(xlUp))
            Dic(Cl.Value) = Array(Cl, Cl.Offset(, 1).Value)
        Next Cl
    End With
    With Sheets("Sheet1")
        For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            If Not Dic.Exists(Cl.Value) Then
               Cl.Offset(0, 1).Interior.Color = vbGreen
            End If
        Next Cl
    End With
    
 WB2.Close False ' closing the Open SO items register
  Application.ScreenUpdating = True

  End Sub