Object variable or with block variable not set

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
467
Office Version
  1. 365
Platform
  1. Windows
I hope somebody can help
I have some code which I have been using for several months all running just great, but now all of a sudden I am getting this error “Object variable or with block variable not set”.
Highlighting this line Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

If anybody could explain what the problem is please I would be extremely grateful. I am a bit lost on what could be wrong.
Many thanks
Full code below
VBA Code:
Sub RefreshDatesCheckIfDispatched() ' Opening SO items Copying relevant dates & checking if dispatched
    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:G" & 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
            If Sheets("Open SO Items").FilterMode Then ActiveSheet.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 ' the SO numbers will be the key for the dictionary
    
   '***************************************
    '   Go back to original workbook
    WB1.Activate
    'Pasting the SO numbers
    Sheets("Sheet2").Range("E2").PasteSpecial xlPasteValues ' the SO numbers will be the key for the dictionary
    Application.CutCopyMode = False
    
    '***************************************
    '   Go back to WB2 copy date requested
     WB2.Activate
        a = Sheets("Open SO Items").Range("M" & Rows.Count).End(xlUp).Row
    Sheets("Open SO Items").Range("M2:M" & a).Copy
    
   '***************************************
    '   Go back to original workbook paste date rquested
    WB1.Activate
    'Pasting date requested
    Sheets("Sheet2").Range("F2").PasteSpecial xlPasteValues
    Application.CutCopyMode = False

    '***************************************
    '   Go back to WB2 copy live completion date
     WB2.Activate
        a = Sheets("Open SO Items").Range("P" & Rows.Count).End(xlUp).Row
    Sheets("Open SO Items").Range("P2:P" & a).Copy
    
   '***************************************
    '   Go back to original workbook paste live completion date
    WB1.Activate
    'Pasting live completion date
    Sheets("Sheet2").Range("G2").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    '**************************************
    '   Go back to WB2 copy live quantity
     WB2.Activate
        a = Sheets("Open SO Items").Range("F" & Rows.Count).End(xlUp).Row
    Sheets("Open SO Items").Range("F2:F" & a).Copy
    
   '***************************************
    '   Go back to original workbook paste live quantity
    WB1.Activate
    'Pasting live completion date
    Sheets("Sheet2").Range("H2").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    '**************************************
    '    Adding the SO numbers, dates & Qty's pasted from the open SO items register to the dictionary
    '    The SO numbers are the dictionary key and all offsets are the values linked to that key
    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.Offset(, 1).Value, Cl.Offset(, 2).Value) ' dictionary key in E, the two offsets added to the dictionary
            Dic(Cl.Value) = Array(Cl.Offset(, 1).Value, Cl.Offset(, 2).Value, Cl.Offset(, 3).Value) ' dictionary key in E, the three offsets added to the dictionary
        Next Cl
    End With
    
   '***************************************
   'checking qty column F & highlighting any cells which totals have changed
   'The dictionary names the first offset value as 0, therfore the next two offsets are 1 & 2 (giving the 3 offsets)
    With Sheets("Sheet1")
            For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            If Dic.Exists(Cl.Value) Then ' Dictionary key
            If Cl.Offset(0, 5).Value <> Dic(Cl.Value)(2) Then 'checking the Qty in column F sheet 1 against the value for Qty in the dictionary
             Cl.Offset(0, 5).Interior.Color = vbYellow
            End If
        End If
            
        Next Cl
    End With
    
     '***************************************
     
     'The dictionary names the first offset value as 0, therefore the next two offsets are 1 & 2 (giving the 3 offsets)
    With Sheets("Sheet1")
        For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            If Dic.Exists(Cl.Value) Then ' Dictionary key
               Cl.Offset(, 8).Value = Dic(Cl.Value)(0) 'Date required (Cl.Offset(, 1)
               Cl.Offset(, 9).Value = Dic(Cl.Value)(1) 'live completion date (Cl.Offset(, 2)
               Cl.Offset(, 5).Value = Dic(Cl.Value)(2) 'Quantity (Cl.Offset(, 3)
            End If
         Next Cl
         
        For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            If Not Dic.Exists(Cl.Value) Then   ' if it does not appear in the Dic (dictionary) then highlight green
             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
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Your code assumes that the activecell is in a table but there is no guarantee that will be the case.
 
Upvote 0
Solution
Hi Rory
Thank you so much, I would have never figured that out
Bagsy
 
Upvote 0

Forum statistics

Threads
1,215,903
Messages
6,127,651
Members
449,395
Latest member
Perdi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top