"Runtime error '1004': Select method of Range class failed"

Glitch5618

Glitch5618

Board Regular
Joined
Nov 6, 2015
Messages
105
Code made in excel 2007, currently working in excel 2013 with no problems other than the issue below.

I'm at a complete loss on this one. The code below works perfectly fine, but only when the code in blue is removed. WHY? How can this be resolved? I'm very confused. I've tried putting the code in red in different formats but nothing seems to work. Any ideas on how to solve this? I need the blue code section for the code to work properly and this is throwing a wrench in my program...

Rich (BB code): 
'Test for escalation data.
For Each eWS In Worksheets
    If eWS.Name Like "Escalation Data" Then flg2 = True: Exit For
    Next
        If flg2 = True Then
            f.optEscalation.Enabled = True
            With eWS
                If eWS.ListObjects.Count = 1 Then
                    .ListObjects(1).Name = "EscalationData"
                ElseIf eWS.ListObjects.Count = 0 Then
                     eWS.ListObjects.Add(xlSrcRange, eWS.UsedRange, , xlYes).Name = "EscalationData"
                End If
            Set eWS = Worksheets("Escalation Data")
            'Delimter code: Makes sure the date column is recognized by excel as a date format.
            eWS.Range("EscalationData[Date]").TextToColumns Destination:=Range("EscalationData[Date]"), _
            DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 3), TrailingMinusNumbers:=True
            End With


            'Test for Tenure 2 column
            eWS.Visible = xlSheetHidden
            eWS.Activate
            FinalRow = eWS.Cells(Application.Rows.Count, 1).End(xlUp).Row
            FinalCol = eWS.Cells(1, Application.Columns.Count).End(xlToLeft).Column


            If HeaderExists("EscalationData", "Tenure 2") = True Then
            Else
                eWS.Cells(1, FinalCol + 1).Value = "Tenure 2"
                eWS.Cells(2, FinalCol + 1).Formula = "=IF(EscalationData[[Tenure]]<90,""< 90 Days"",IF(AND(EscalationData[[Tenure]=]=>=90,EscalationData[[Tenure]]<180),""90 to 180 Days"",IF(AND(EscalationData[[Tenure]=]=>=180,EscalationData[[Tenure]]<365),""6 Months to 1 Year"",IF(AND(EscalationData[[Tenure]=]=>=365,EscalationData[[Tenure]]<730),""1 - 2 Years"",IF(AND(EscalationData[[Tenure]=]=>=730,EscalationData[[Tenure]]<1095),""2 - 3 Years"",IF(AND(EscalationData[[Tenure]=]=>=1095,EscalationData[[Tenure]]<1460),""3 - 4 Years"", IF(AND(EscalationData[[Tenure]=]=>=1460,EscalationData[[Tenure]]<1825),""4 - 5 Years"",IF(AND(EscalationData[[Tenure]=]=>=1825,EscalationData[[Tenure]]<2190),""5 - 6 Years"",IF(EscalationData[[Tenure]=]=>=2190,""> 6 Years"")))))))))"
            End If
            'Must hide sheet or throws error
            eWS.Visible = xlSheetVeryHidden
        End If




'Agent List - Column A
QuestionList:
'On Error GoTo qAgentHandle
qWS.Range("QuestionData[Agent Name]").AdvancedFilter Action:=xlFilterCopy, copytorange:=lws.Range("A1"), Unique:=True
Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


This is the RAW code, in case it would help solve this issue.
Rich (BB code): 
Sub ListGeneration()
Application.ScreenUpdating = False
Dim rng As Range
Dim flg As Boolean, flg2 As Boolean
Dim LR As Long, LR2 As Long, LC As Long, FinalCol As Long, FinalRow As Long
Dim lws As Worksheet, qWS As Worksheet, eWS As Worksheet, rWS As Worksheet
Set f = UserForm
Set lws = Sheets.Add: lws.Name = "Lists"
NoGo = False


'Test for question data.
For Each qWS In Worksheets
    If qWS.Name Like "Question Data" Then flg = True: Exit For
    Next
        If flg = True Then
            f.optQuestion.Enabled = True
            With qWS
                If qWS.ListObjects.Count = 1 Then
                    .ListObjects(1).Name = "QuestionData"
                ElseIf qWS.ListObjects.Count = 0 Then
                     qWS.ListObjects.Add(xlSrcRange, qWS.UsedRange, , xlYes).Name = "QuestionData"
                End If
            Set qWS = Worksheets("Question Data")
            'Delimter code: Makes sure the date column is recognized by excel as a date format.
            qWS.Range("QuestionData[Date]").TextToColumns Destination:=Range("QuestionData[Date]"), _
            DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 3), TrailingMinusNumbers:=True
            End With
        End If
        
'Test for escalation data.
For Each eWS In Worksheets
    If eWS.Name Like "Escalation Data" Then flg2 = True: Exit For
    Next
        If flg2 = True Then
            f.optEscalation.Enabled = True
            With eWS
                If eWS.ListObjects.Count = 1 Then
                    .ListObjects(1).Name = "EscalationData"
                ElseIf eWS.ListObjects.Count = 0 Then
                     eWS.ListObjects.Add(xlSrcRange, eWS.UsedRange, , xlYes).Name = "EscalationData"
                End If
            Set eWS = Worksheets("Escalation Data")
            'Delimter code: Makes sure the date column is recognized by excel as a date format.
            eWS.Range("EscalationData[Date]").TextToColumns Destination:=Range("EscalationData[Date]"), _
            DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 3), TrailingMinusNumbers:=True
            End With


            'Test for Tenure 2 column
            eWS.Visible = xlSheetHidden
            eWS.Activate
            FinalRow = eWS.Cells(Application.Rows.Count, 1).End(xlUp).Row
            FinalCol = eWS.Cells(1, Application.Columns.Count).End(xlToLeft).Column


            If HeaderExists("EscalationData", "Tenure 2") = True Then
            Else
                eWS.Cells(1, FinalCol + 1).Value = "Tenure 2"
                eWS.Cells(2, FinalCol + 1).Formula = "=IF(EscalationData[[Tenure]]<90,""< 90 Days"",IF(AND(EscalationData[[Tenure]=]=>=90,EscalationData[[Tenure]]<180),""90 to 180 Days"",IF(AND(EscalationData[[Tenure]=]=>=180,EscalationData[[Tenure]]<365),""6 Months to 1 Year"",IF(AND(EscalationData[[Tenure]=]=>=365,EscalationData[[Tenure]]<730),""1 - 2 Years"",IF(AND(EscalationData[[Tenure]=]=>=730,EscalationData[[Tenure]]<1095),""2 - 3 Years"",IF(AND(EscalationData[[Tenure]=]=>=1095,EscalationData[[Tenure]]<1460),""3 - 4 Years"", IF(AND(EscalationData[[Tenure]=]=>=1460,EscalationData[[Tenure]]<1825),""4 - 5 Years"",IF(AND(EscalationData[[Tenure]=]=>=1825,EscalationData[[Tenure]]<2190),""5 - 6 Years"",IF(EscalationData[[Tenure]=]=>=2190,""> 6 Years"")))))))))"
            End If
            'Must hide sheet or throws error
            eWS.Visible = xlSheetVeryHidden
        End If
        
'Test for roster sheet.
For Each rWS In Worksheets
    If rWS.Name Like "Roster" Then SDMval = True: Exit For
    Next
        If SDMval = True Then
            With rWS
                Set rWS = Worksheets("Roster")
                rWS.Visible = xlSheetVisible
            End With
        Else
            SDMval = False
        End If
        
'Conditional statements to direct code
If SDMval = False Then
    MsgBox "No roster data found. Sheet must have exact name of ""Roster"" to function." & vbNewLine & vbNewLine & _
        "Please rename sheet and reload program, otherwise SDM filters will remain disabled."
End If


If flg = False And flg2 = True Then
    'Only escalation data
    f.optQuestion.Enabled = False
    f.optBoth.Enabled = False
    MsgBox "No question data found. Sheet must have exact name of ""Question Data"" to function." & vbNewLine & vbNewLine & _
        "Please rename sheet and reload program, otherwise question filters will remain disabled."
    GoTo EscalationList
    
ElseIf flg = True And flg2 = False Then
    'Only question data
    f.optEscalation.Enabled = False
    f.optBoth.Enabled = False
    MsgBox "No escalation data found. Sheet must have exact name of ""Escalation Data"" to function." & vbNewLine & vbNewLine & _
        "Please rename sheet and reload program, otherwise escalation filters will remain disabled."
    GoTo QuestionList
ElseIf flg = False And flg2 = False Then
    'No data
    f.optQuestion.Enabled = False
    f.optEscalation.Enabled = False
    f.optBoth.Enabled = False
    MsgBox "No data found. Sheet must have exact name of ""Question Data"" & ""Escalation Data"" to function." & vbNewLine & vbNewLine & _
        "Please rename sheets and reload program, otherwise all filter options will remain disabled."
End If


'QUESTION SECTION
'==================================================================================================
'Agent List - Column A
QuestionList:
'On Error GoTo qAgentHandle
qWS.Range("QuestionData[Agent Name]").AdvancedFilter Action:=xlFilterCopy, copytorange:=lws.Range("A1"), Unique:=True
Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


'TL List - Column B
On Error GoTo qTLhandle
qWS.Range("QuestionData[SDS]").AdvancedFilter Action:=xlFilterCopy, copytorange:=lws.Range("B1"), Unique:=True
Columns("B:B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        
'LOB List - Column C
On Error GoTo qLOBhandle
qWS.Range("QuestionData[LOB]").AdvancedFilter Action:=xlFilterCopy, copytorange:=lws.Range("C1"), Unique:=True
Columns("C:C").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


'BAM List - Column D
On Error GoTo qBAMhandle
qWS.Range("QuestionData[BAM]").AdvancedFilter Action:=xlFilterCopy, copytorange:=lws.Range("D1"), Unique:=True
Columns("D:D").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


'If no data found for escalations, skips code sections
If flg2 = False And SDMval = True Then
    GoTo SDMlist
ElseIf flg2 = False And SDMval = False Then
    GoTo SDMend
End If


'ESCALATION SECTION
'==================================================================================================
'Agent List - Column E
EscalationList:
On Error GoTo eAgentHandle
eWS.Range("EscalationData[Agent Name]").AdvancedFilter Action:=xlFilterCopy, copytorange:=lws.Range("E1"), Unique:=True
Columns("E:E").Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


'TL List - Column F
On Error GoTo eTLhandle
eWS.Range("EscalationData[Manager Name]").AdvancedFilter Action:=xlFilterCopy, copytorange:=lws.Range("F1"), Unique:=True
Columns("F:F").Sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        
'LOB List - Column G
On Error GoTo eLOBhandle
eWS.Range("EscalationData[LOB]").AdvancedFilter Action:=xlFilterCopy, copytorange:=lws.Range("G1"), Unique:=True
Columns("G:G").Sort Key1:=Range("G1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


'BAM List - Column H
On Error GoTo eBAMhandle
eWS.Range("EscalationData[BAM]").AdvancedFilter Action:=xlFilterCopy, copytorange:=lws.Range("H1"), Unique:=True
Columns("H:H").Sort Key1:=Range("H1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


'If no data found for quesitons or escalations, both section skipped.
If flg = False Or flg2 = False And SDMval = True Then
    GoTo SDMlist
ElseIf flg = False Or flg2 = False And SDMval = False Then
    GoTo SDMend
End If


'BOTH SECTION
'==================================================================================================
'Agent List - Column I
LR = lws.Range("A" & Rows.Count).End(xlUp).Row 'Bottom of question agent list
lws.Range("A2:A" & LR).Copy Destination:=lws.Range("I1") 'copy question list to both column
    LR = lws.Range("E" & Rows.Count).End(xlUp).Row 'bottom of escalation agent list
    LR2 = lws.Range("I" & Rows.Count).End(xlUp).Row 'bottom of both list
        lws.Range("E2:E" & LR).Copy Destination:=Range("I" & LR2 + 1) 'copy escalation list to bottom of both list
lws.Range("I:I").RemoveDuplicates Columns:=1, Header:=xlNo
Columns("I:I").Sort Key1:=Range("I1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


'TL List - Column J
LR = lws.Range("B" & Rows.Count).End(xlUp).Row
lws.Range("B2:B" & LR).Copy Destination:=lws.Range("J1")
    LR = lws.Range("F" & Rows.Count).End(xlUp).Row
    LR2 = lws.Range("J" & Rows.Count).End(xlUp).Row
        lws.Range("F2:F" & LR).Copy Destination:=Range("J" & LR2 + 1)
lws.Range("J:J").RemoveDuplicates Columns:=1, Header:=xlNo
Columns("J:J").Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


'LOB List - Column K
LR = lws.Range("C" & Rows.Count).End(xlUp).Row
lws.Range("C2:C" & LR).Copy Destination:=lws.Range("K1")
    LR = lws.Range("G" & Rows.Count).End(xlUp).Row
    LR2 = lws.Range("K" & Rows.Count).End(xlUp).Row
        lws.Range("G2:G" & LR).Copy Destination:=Range("K" & LR2 + 1)
lws.Range("K:K").RemoveDuplicates Columns:=1, Header:=xlNo
Columns("K:K").Sort Key1:=Range("K1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


'BAM List - Column L
LR = lws.Range("D" & Rows.Count).End(xlUp).Row
lws.Range("D2:D" & LR).Copy Destination:=lws.Range("L1")
    LR = lws.Range("H" & Rows.Count).End(xlUp).Row
    LR2 = lws.Range("L" & Rows.Count).End(xlUp).Row
        lws.Range("H2:H" & LR).Copy Destination:=Range("L" & LR2 + 1)
lws.Range("L:L").RemoveDuplicates Columns:=1, Header:=xlNo
Columns("L:L").Sort Key1:=Range("L1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


'If no Roster sheet is found skip SDM code
If SDMval = False Then
    GoTo SDMend
End If


'SDM List - Column M
'Remove any formatting and creates a table to allow autofilter use
SDMlist:
LR = rWS.Cells(Rows.Count, "A").End(xlUp).Row 'Find last row
LC = rWS.Cells(1, Columns.Count).End(xlToLeft).Column 'Find last column
rWS.Cells.ClearFormats
rWS.Activate
    On Error Resume Next
    rWS.ListObjects.Add(xlSrcRange, Range("A1:F" & LR), , xlYes).Name = "Roster Table"
    Application.DisplayAlerts = False
    rWS.Range(Cells(1, 7), Cells(LR, LC)).Delete 'Delete useless data to the left of table
    Application.DisplayAlerts = True


'AutoFilter Gate column of roster data, any information NOT containing "Morgantown" is filtered out.
With rWS
    .AutoFilterMode = False
    With Range("F1", Range("F" & Rows.Count).End(xlUp))
        .AutoFilter 6, "<>*Morgantown*"
        On Error Resume Next
    End With
End With


'Deletes any extra data and then displays only Morgantown site information
Set rng = rWS.UsedRange
With rng
    .Offset(1, 0).EntireRow.Delete
End With
rWS.ListObjects("Roster Table").Range.AutoFilter Field:=6


'Copy filtered table to List worksheet and remove useless data
rWS.UsedRange.Copy
lws.Range("AA1").PasteSpecial xlPasteValues
lws.Columns("AA:AB").Delete
lws.Columns("AB").Delete
lws.Columns("AC").Delete


'Remove table from roster worksheet
rWS.ListObjects("Roster Table").Unlist


'Conditional statement in case no data is pulled from roster sheet
LR = lws.Cells(Rows.Count, "AA").End(xlUp).Row
If LR = 0 Then
    'No data
    MsgBox "No data pulled from roster sheet. Check roster format with code. SDM filter options disabled."
        SDMval = False
        GoTo endcode
End If


'Create SDM table for future reference
lws.Activate
    On Error Resume Next
    lws.ListObjects.Add(xlSrcRange, Range(Cells(1, 27), Cells(LR, 28)), , xlYes).Name = "SDMtable"
   
'Remove duplicate names
lws.Range("SDMtable").RemoveDuplicates Columns:=1, Header:=xlYes


'Filter SDM list and sort
lws.Range("AB:AB").AdvancedFilter Action:=xlFilterCopy, copytorange:=lws.Range("M1"), Unique:=True
Columns("M:M").Sort Key1:=Range("M1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


endcode:
lws.Visible = xlSheetVeryHidden
rWS.Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
Exit Sub


SDMend:
lws.Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
Exit Sub


'Error handling for table header references
'==================================================================================================
'QUESTION SECTION
qAgentHandle:
    MsgBox "Unable to locate ""Agent Name"" table header within Question Data sheet." & vbNewLine & vbNewLine & "Table header name must match exactly."
        NoGo = True
        GoTo HeaderRefenceEnd


qTLhandle:
    MsgBox "Unable to locate ""SDS"" table header within Question Data sheet." & vbNewLine & vbNewLine & "Table header name must match exactly."
        NoGo = True
        GoTo HeaderRefenceEnd
        
qLOBhandle:
    MsgBox "Unable to locate ""LOB"" table header within Question Data sheet." & vbNewLine & vbNewLine & "Table header name must match exactly."
        NoGo = True
        GoTo HeaderRefenceEnd
    
qBAMhandle:
    MsgBox "Unable to locate ""BAM"" table header within Question Data sheet." & vbNewLine & vbNewLine & "Table header name must match exactly."
        NoGo = True
        GoTo HeaderRefenceEnd
        
'ESCALATION SECTION
eAgentHandle:
    MsgBox "Unable to locate ""Agent Name"" table header within Escalation Data sheet." & vbNewLine & vbNewLine & "Table header name must match exactly."
        NoGo = True
        GoTo HeaderRefenceEnd
        
eTLhandle:
    MsgBox "Unable to locate ""Manger Name"" table header within Escalation Data sheet." & vbNewLine & vbNewLine & "Table header name must match exactly."
        NoGo = True
        GoTo HeaderRefenceEnd
        
eLOBhandle:
    MsgBox "Unable to locate ""LOB"" table header within Escalation Data sheet." & vbNewLine & vbNewLine & "Table header name must match exactly."
        NoGo = True
        GoTo HeaderRefenceEnd
        
eBAMhandle:
    MsgBox "Unable to locate ""BAM"" table header within Escalation Data sheet." & vbNewLine & vbNewLine & "Table header name must match exactly."
        NoGo = True
        GoTo HeaderRefenceEnd
        
HeaderRefenceEnd:
Application.DisplayAlerts = False
lws.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Last edited:

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
If you hide a sheet you cant then activate it. You couldn't do that manually so you cant with code. However as it looks like you are qualifying the sheet each time there is no need to activate it at all. Just remove the activate line.
 
Upvote 0
Well you were right that does fix the issue. However for the purposes of my code it does have to be activated, and for whatever reason it does make a difference. Even if the worksheet is xlSheetVeryHidden, If I don't eWS.activate line then my function below that checks for the table header will fail and it will create a new column every time the code runs. So I end up with 5 columns of the same data after I start my program 5 times, which is something I definitely don't want!

I've solved the issue by just activating the "Lists" worksheet before the trouble code, it seems to work now. Thanks for the quick response!
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
Custom Sorting in VBA
Replies
3
Views
521
Micron
M
O
  • Question Question
User-defined type not defined - vba/excel error
Replies
4
Views
142
RoryA
RoryA
R
  • Question Question
Runtime Error 91
2
Replies
15
Views
616
rtr1811
R
R
  • Solved
Is there a way for this VBA code to Ignore the spaces & give the results at the top of the page?
2
Replies
10
Views
621
Alex Blakenburg
A
D
  • Question Question
VBA to Create Outlook Email Not Working for All Users
Replies
9
Views
287
Logit
Logit

Forum statistics

Threads
1,223,243
Messages
6,170,967
Members
452,371
Latest member
Frana

Share this page

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