Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Intermittent error - Object Variable or with block variable not set

Status
Not open for further replies.
EliseFreedman

EliseFreedman

Programmer
Dec 6, 2002
470
GB
Hi All

I have a reporting dashboard which users can use to filter data on a report at runtime. The filters are on one sheet and the code uses those filters to filter data on another sheet. 9 times out of 10 the filter works perfectly but occassionally, we get the following error

Object Variable or with block variable not set

The line My_Range.Parent.AutoFilter.Range.Copy is highlighted in yellow

Does anyone know why we would get this error and what I can do to resolve it. The strange thing is that it is just happening intermittently

Code: 
Sub Copy_With_AutoFilter1()

'Note: This macro use the function LastRow
    Dim My_Range As Range
    Dim CalcMode As Long
    Dim ViewMode As Long
    Dim FilterCriteria As String
    Dim CCount As Long
 
    Dim wsNew As Worksheet
    
    Dim sheetName As String
    Dim rng As Range
    Dim Criteria As String
    Dim Criteria1 As String
    Dim Criteria2 As String
   Dim Criteria3 As String
   Dim Criteria4 As String
   
     Dim CheckBox11 As Shape
      Dim CheckBox17 As Shape
     Dim CheckBox3 As Shape
        Dim CheckBox33 As Shape

Dim wsheet As Worksheet
 For Each wsheet In Worksheets

 wsheet.Select
 ActiveSheet.Unprotect Password:="HealthyWorking"

 Next wsheet





Sheets("FILTER").Select
Criteria1 = ActiveSheet.Range("H4") 'Function
Criteria2 = ActiveSheet.Range("H6") 'Site
Criteria3 = ActiveSheet.Range("H11") 'Compliance Status

    'Set filter range on ActiveSheet: A11 is the top left cell of your filter range
    'and the header of the first column, D is the last column in the filter range.
    'You can also add the sheet name to the code like this :
    'Worksheets("Sheet1").Range("A11:D" & LastRow(Worksheets("Sheet1")))
    'No need that the sheet is active then when you run the macro when you use this.

    Sheets("REPORT_DSETraining").Select




    Set My_Range = Range("A1:N" & LastRow(ActiveSheet))
    My_Range.Parent.Select

    If ActiveWorkbook.ProtectStructure = True Or _
       My_Range.Parent.ProtectContents = True Then
        MsgBox "Sorry, not working when the workbook or worksheet is protected", _
               vbOKOnly, "Copy to new worksheet"
        Exit Sub
    End If

    'Change ScreenUpdating, Calculation, EnableEvents, ....
    With Application
        CalcMode = .Calculation
       ' .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    ActiveSheet.DisplayPageBreaks = False

    'Firstly, remove the AutoFilter
    My_Range.Parent.AutoFilterMode = False

    'Filter and set the filter field and the filter criteria :
    'This example filter on the first column in the range (change the field if needed)
    'In this case the range starts in A so Field 1 is column A, 2 = column B, ......
    'Use "<>Netherlands" as criteria if you want the opposite
    'My_Range.AutoFilter Field:=1, Criteria1:="=Netherlands"

    'If you want to filter on a cell value you can use this, use "<>" for the opposite
    'This example uses the activecell value
    'My_Range.AutoFilter Field:=1, Criteria1:="=" & ActiveCell.Value

    'This will use the cell value from A2 as criteria
    
   
'Function
Set CheckBox3 = Sheets("FILTER").Shapes("Check Box 3") 'Change the CheckBox number you want to check

If CheckBox3.OLEFormat.Object.Value = 1 Then
    
        My_Range.AutoFilter Field:=4, Criteria1:="=" & Criteria1
   
        End If


'Site
Set CheckBox17 = Sheets("FILTER").Shapes("Check Box 17") 'Change the CheckBox number you want to check

If CheckBox17.OLEFormat.Object.Value = 1 Then


  My_Range.AutoFilter Field:=5, Criteria1:="=" & Criteria2
  End If
  
  
'Compliance Status
Set CheckBox33 = Sheets("FILTER").Shapes("Check Box 33") 'Change the CheckBox number you want to check


If CheckBox33.OLEFormat.Object.Value = 1 Then

 My_Range.AutoFilter Field:=7, Criteria1:="=" & Criteria3

 End If
 
   

  

    ''If you want to filter on a Inputbox value use this
    'FilterCriteria = InputBox("What text do you want to filter on?", _
     '                              "Enter the filter item.")
    'My_Range.AutoFilter Field:=1, Criteria1:="=" & FilterCriteria

    'Check if there are not more then 8192 areas(limit of areas that Excel can copy)
    CCount = 0
    On Error Resume Next
    CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
    On Error GoTo 0
    If CCount = 0 Then
        MsgBox "There are more than 8192 areas:" _
             & vbNewLine & "It is not possible to copy the visible data." _
             & vbNewLine & "Tip: Sort your data before you use this macro.", _
               vbOKOnly, "Copy to worksheet"
               
               

    Else
           Dim wbNew As Workbook
'add new workbook


    Set wbNew = Workbooks.Add
wbNew.Activate
    Set wsNew = wbNew.Worksheets(1)
    wsNew.Name = "DSE Status Report"
  'Copy/paste the visible data to the new worksheet
    My_Range.Parent.AutoFilter.Range.Copy
    



    
    
    With wsNew.Range("A1")
        ' Paste:=8 will copy the columnwidth in Excel 2000 and higher
        ' Remove this line if you use Excel 97
        .PasteSpecial Paste:=8
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        wbNew.Activate
        wsNew.Activate
        .Select
    End With
wbNew.SaveAs "H:\DSEStatusReport" & ".xls"
Call Macro9

Windows("ReportDashboard.xlsm").Activate
For Each wsheet In Worksheets

 wsheet.Select
 ActiveSheet.Protect Password:="HealthyWorking"

 Next wsheet
 
wbNew.Sheets("DSE Status Report").Activate

End If


End Sub
 
Sort by date Sort by votes
Hi,

Unless My_Range is intended to be associated with any of multiple sheets, I'd make the WorkSheet Object refer to the specific sheet...
Code: 
Set My_Range = Range("A1:N" & LastRow([b]ActiveSheet[/b]))
...or just activate the sheet prior to this statement.

Oops, I see that you have done this.

Actually, I would NOT use ActiveSheet and Select methods in my code, but reference all objects explicitly. Selecting slowes down code execution unnecessarily.

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
I'd do something like this...
Code: 
Sub Copy_With_AutoFilter1()

    'Note: This macro use the function LastRow
    Dim My_Range As Range
    Dim CalcMode As Long
    Dim ViewMode As Long
    Dim FilterCriteria As String
    Dim CCount As Long
    Dim wsNew As Worksheet
    Dim sheetName As String
    Dim rng As Range
    Dim Criteria As String
    Dim Criteria1 As String
    Dim Criteria2 As String
    Dim Criteria3 As String
    Dim Criteria4 As String
    Dim CheckBox11 As Shape
    Dim CheckBox17 As Shape
    Dim CheckBox3 As Shape
    Dim CheckBox33 As Shape
    Dim wsheet As Worksheet
    Dim wbNew As Workbook
    
    For Each wsheet In Worksheets
    
        wsheet.Unprotect Password:="HealthyWorking"
    
    Next wsheet
    
    With Sheets("FILTER")
        Criteria1 = .Range("H4") 'Function
        Criteria2 = .Range("H6") 'Site
        Criteria3 = .Range("H11") 'Compliance Status
    End With
    
    'Set filter range on ActiveSheet: A11 is the top left cell of your filter range
    'and the header of the first column, D is the last column in the filter range.
    'You can also add the sheet name to the code like this :
    'Worksheets("Sheet1").Range("A11:D" & LastRow(Worksheets("Sheet1")))
    'No need that the sheet is active then when you run the macro when you use this.
    
    With Sheets("REPORT_DSETraining")
    
        Set My_Range = .Range("A1:N" & LastRow(Sheets("REPORT_DSETraining")))
    
        If ThisWorkbook.ProtectStructure Or _
           .ProtectContents Then
            MsgBox "Sorry, not working when the workbook or worksheet is protected", _
                   vbOKOnly, "Copy to new worksheet"
            Exit Sub
        End If
    
        'Change ScreenUpdating, Calculation, EnableEvents, ....
        With Application
            CalcMode = .Calculation
           ' .Calculation = xlCalculationManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView
        .DisplayPageBreaks = False
    
        'Firstly, remove the AutoFilter
        My_Range.Parent.AutoFilterMode = False
    End With
    
    'Filter and set the filter field and the filter criteria :
    'This example filter on the first column in the range (change the field if needed)
    'In this case the range starts in A so Field 1 is column A, 2 = column B, ......
    'Use "<>Netherlands" as criteria if you want the opposite
    'My_Range.AutoFilter Field:=1, Criteria1:="=Netherlands"

    'If you want to filter on a cell value you can use this, use "<>" for the opposite
    'This example uses the activecell value
    'My_Range.AutoFilter Field:=1, Criteria1:="=" & ActiveCell.Value

    'This will use the cell value from A2 as criteria
       
    'Function
    Set CheckBox3 = Sheets("FILTER").Shapes("Check Box 3") 'Change the CheckBox number you want to check
    
    If CheckBox3.OLEFormat.Object.Value = 1 Then
        
        My_Range.AutoFilter Field:=4, Criteria1:="=" & Criteria1

    End If
    
    'Site
    Set CheckBox17 = Sheets("FILTER").Shapes("Check Box 17") 'Change the CheckBox number you want to check
    
    If CheckBox17.OLEFormat.Object.Value = 1 Then
    
        My_Range.AutoFilter Field:=5, Criteria1:="=" & Criteria2
    
    End If
      
    'Compliance Status
    Set CheckBox33 = Sheets("FILTER").Shapes("Check Box 33") 'Change the CheckBox number you want to check
    
    If CheckBox33.OLEFormat.Object.Value = 1 Then
    
        My_Range.AutoFilter Field:=7, Criteria1:="=" & Criteria3
    
    End If
    
    ''If you want to filter on a Inputbox value use this
    'FilterCriteria = InputBox("What text do you want to filter on?", _
     '                              "Enter the filter item.")
    'My_Range.AutoFilter Field:=1, Criteria1:="=" & FilterCriteria

    'Check if there are not more then 8192 areas(limit of areas that Excel can copy)
    CCount = 0
    On Error Resume Next
    CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
    On Error GoTo 0
    If CCount = 0 Then
        MsgBox "There are more than 8192 areas:" _
             & vbNewLine & "It is not possible to copy the visible data." _
             & vbNewLine & "Tip: Sort your data before you use this macro.", _
               vbOKOnly, "Copy to worksheet"
    Else
        'add new workbook
        Set wbNew = Workbooks.Add
        wbNew.Activate
        Set wsNew = wbNew.Worksheets(1)
        wsNew.Name = "DSE Status Report"
        'Copy/paste the visible data to the new worksheet
        My_Range.Parent.AutoFilter.Range.Copy
        
        With wsNew.Range("A1")
            ' Paste:=8 will copy the columnwidth in Excel 2000 and higher
            ' Remove this line if you use Excel 97
            .PasteSpecial Paste:=8
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
'            wbNew.Activate
'            wsNew.Activate
            .Select
        End With
        wbNew.SaveAs "H:\DSEStatusReport" & ".xls"
        Call Macro9
        
'        Windows("ReportDashboard.xlsm").Activate
        For Each wsheet In Worksheets
            
            wsheet.Protect Password:="HealthyWorking"
            
        Next wsheet
        
'        wbNew.Sheets("DSE Status Report").Activate
    
    End If


End Sub


Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
Thanks Skip

Looks as if this is working

I have another module which allows the user to filter all three training reports at once for their function etc.

I am getting the same error message as before.

I am trying to modify the code using your code above but am failing miserably

Code: 
Sub Copy_With_AutoFilter4()
DisplayAlerts = False
'Note: This macro use the function LastRow
    Dim My_Range As Range
    Dim CalcMode As Long
    Dim ViewMode As Long
    Dim FilterCriteria As String
    Dim CCount As Long
    Dim wsNew As Worksheet
    Dim wbNew As Workbook
    Dim sheetName As String
    Dim rng As Range
    Dim Criteria As String
    Dim Criteria1 As String
    Dim Criteria2 As String
   Dim Criteria3 As String
   Dim Criteria4 As String
   Dim wsheet As Worksheet
   
     Dim CheckBox11 As Shape
      Dim CheckBox17 As Shape
     Dim CheckBox3 As Shape
        Dim CheckBox33 As Shape
    



 For Each wsheet In Worksheets

 wsheet.Unprotect Password:="HealthyWorking"

 Next wsheet

With Sheets("FILTER")
Criteria1 = .Range("H4") 'Function
Criteria2 = .Range("H6") 'Site
Criteria3 = .Range("H11") 'Compliance Status
    'Set filter range on ActiveSheet: A11 is the top left cell of your filter range
    'and the header of the first column, D is the last column in the filter range.
    'You can also add the sheet name to the code like this :
    'Worksheets("Sheet1").Range("A11:D" & LastRow(Worksheets("Sheet1")))
    'No need that the sheet is active then when you run the macro when you use this.

  End With


For Each ws In ThisWorkbook.Worksheets
Set My_Range = .Range("A1:AG" & LastRow(ActiveSheet))
If (Left(ws.Name, 1) = "R") Then
    With ws
      Set CheckBox3 = Sheets("FILTER").Shapes("Check Box 3") 'Change the CheckBox number you want to check
If CheckBox3.OLEFormat.Object.Value = 1 Then
      My_Range.AutoFilter Field:=4, Criteria1:=Array(Criteria1), Operator:=xlFilterValues
End If
    Set CheckBox17 = Sheets("FILTER").Shapes("Check Box 17") 'Change the CheckBox number you want to check
If CheckBox17.OLEFormat.Object.Value = 1 Then
        My_Range.AutoFilter Field:=5, Criteria1:=Array(Criteria2), Operator:=xlFilterValues
 End If
     Set CheckBox33 = Sheets("FILTER").Shapes("Check Box 33") 'Change the CheckBox number you want to check
If CheckBox33.OLEFormat.Object.Value = 1 Then
        My_Range.AutoFilter Field:=7, Criteria1:=Array(Criteria3), Operator:=xlFilterValues
End If
End With
    End If
Next
Application.ScreenUpdating = False
Selection.AutoFilter

Dim strSaveName As String
     '
     ' get name to save new workbook as. change reference as needed
    strSaveName = "Functional_TrainingComplianceReport"
     
     ' copy sheets to new workbook
    Sheets(Array("REPORT_TrainingSummary", "REPORT_DSETraining", "REPORT_PassportTraining", _
        "REPORT_AADrivetech", "PassportTrainingTableView", "AADriveTechTableView", _
        "DSEComplianceTableView")).Copy
    ActiveWorkbook.SaveAs strSaveName & ".xls"

        
   '        Windows(Functional_TrainingComplianceReport.xlsx).Activate
For Each wsheet In Worksheets

 wsheet.Select
 ActiveSheet.Protect Password:="HealthyWorking"

 Next wsheet
 
        
End Sub
 
Upvote 0 Downvote
I notice this...
Code: 
'...
   For Each [b]ws[/b] In ThisWorkbook.Worksheets
      Set My_Range = [b]ws[/b].Range("A1:AG" & LastRow([b]ActiveSheet[/b]))
'...

Are you setting My_Range for each ws?

If so then...
Code: 
'...
   For Each [b]ws[/b] In ThisWorkbook.Worksheets
      Set My_Range = [b]ws[/b].Range("A1:AG" & LastRow([b]ws[/b]))
'...
Otherwise, is there any reason to have Set My_Range within the For Each ws loop?

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
Hi Skip

When I try to change the code and run it, I am getting a Compile Error - ByRef Argument Type mismatch
 
Upvote 0 Downvote
How is ws declared?

Is it declared the same as the argument in lastRow?

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
1) you ought to have
Code: 
Option Explicit
'.....
...in each and every code sheet at the very top (which is automatic when you have the box checked in Tools > Options -- Editor... Require variable declaration

2) in a called procedure/function, the data type of the variable(s) must match from the calling procedure to the called procedure. So if the argument in LastRow is a Worksheet, then the data type of ws must be Worksheet. Your ws is not declared (but it ought to be!!!) and it ought to be declared as the same data type as the LastRow argument.

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

morechocolate
  • Locked
  • Question
run-tune error 3704 operation is not allowed when the object is codes: I don't think so.
Replies
7
Views
921
morechocolate
morechocolate
remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
1K
remeng
remeng
arvarr
  • Locked
  • Question
Variable in Pivot Table 1
Replies
4
Views
224
arvarr
arvarr
foxup
  • Locked
  • Question
CDO TLS or SSL
Replies
1
Views
372
foxup
foxup
remeng
  • Locked
  • Helpful tip
Microsoft Office 365 Word Macro Causing a Project is unviewable error
Replies
1
Views
891
dhookom
dhookom

Part and Inventory Search

Sponsor

Back
Top