Trouble With Find Works fine for days then Errors with "runtime error 1004 select method of range class failed"

S

Shiseiji

Board Regular
Joined
Oct 23, 2009
Messages
214
Office Version
  1. 2019
Platform
  1. Windows
Here is all of the code. Makes me pull what's left of my hair out when it works for weeks then stops. Sometimes it will error on one Find, i.e. "UPN" then run fine on everything else. Then if I rem that error, manually create the range, sometimes if continues fine, other times it errors on every find. The data is from a a file I have to make many corrections to dates, but not the "UPN", "STATUS", or "EMPLOYEE ID" columns. This time it failed on the "UPN" column.

As always, TIA
Ron






Code: 
Sub Dates()
    'create date ranges
    '9/18/17 changed UPN to LogOn ID as search will always be by log on ID.
    ' 5/2/2019 updated code ranges
    '
    '------------------------------------------------------------------
    Sheet2.Activate
    Application.Volatile True
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = False
    '
    
    Dim LastRow                                         As Long
    Dim LastCol                                         As Integer
    Dim rAcells                                         As Range
    Dim rLoopCells                                      As Range
    Dim PCells                                          As Range
    Dim sRange                                          As Range
    Dim ThisWs                                          As Worksheet
    Dim WkSht                                           As Worksheet
    Dim Thiswb                                          As Workbook
    '
    '
    ' v = Array("EMAIL", "UPN", "EMPLOYEE ID", "STATUS", "CARD EXPIRY DATE", "EMPLOYEE AFFILIATION", "LAST", "FIRST")
    '----------------------------------------------------------------------------------------------------------------------
    Set ThisWs = ActiveSheet
    ThisWs.AutoFilterMode = False
    With ThisWs
        LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
        LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'----------------------------------------------------------------------------------------
' range ws_Dates_SearchRow created in m_sort_XDATES
' range "tbl_P" created in m_sort_XDATES
'----------------------------------------------------------------------------------------
    With Range("ws_Dates_SearchRow")
        .Find(What:="Email", LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Select
    End With
    Selection.Name = "headerEmail"
'
    Range("headerEmail").Offset(1, 0).Resize(LastRow).Name = "c_P_Email"
----------------------------------------------------------------------------------------------
    With Range("ws_Dates_SearchRow")
        .Find(What:="UPN", LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Select
    End With
    Selection.Name = "headerUPN"
    '
    Range("headerUPN").Offset(1, 0).Resize(LastRow).Name = "c_P_UPN"
    With Range("c_P_UPN")
        .Replace What:="@USPTO.GOV", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    End With
'-------------------------------------------------------------------------------------
' Change Status case to proper
'-------------------------------------------------------------------------------------
   With Range("ws_Dates_SearchRow")
        .Find(What:="STATUS", LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Select
    End With
    Selection.Name = "headerSTATUS"
    Range("headerSTATUS").Offset(1, 0).Resize(LastRow).Name = "c_P_STATUS"
    With Range("c_P_STATUS")
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),PROPER(" & .Address & "),REPT(" & .Address & ",1))")
        .Columns.AutoFit
End With
'-----------------------------------------------------------------------------------
   With Range("ws_Dates_SearchRow")
        .Find(What:="EMPLOYEE ID", LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Select
    End With
    Selection.Name = "headerID"
    Range("headerID").Offset(1, 0).Resize(LastRow).Name = "c_P_ID"
    Range("c_P_ID").NumberFormat = "General"
'---------------------------------------------------------------------------
With Range("ws_Dates_SearchRow")
        .Find(What:="CARD EXPIRY DATE", LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Select
    End With
    Selection.Name = "headerXDATE"
    Range("headerID").Offset(1, 0).Resize(LastRow).Name = "c_P_XDATE"
    Range("c_P_ID").NumberFormat = "General"
'---------------------------------------------------------------------------
   With Range("headerXDATE")
        .EntireColumn.Offset(0, 1).Insert
        .Offset(0, 1).Name = "header6M"
        .Offset(0, 1).Value = "Under 6 Months"
    End With
    Range("header6M").Offset(1, 0).Resize(LastRow).Name = "rng6M"
    '
    With Range("rng6M")
        .FormulaR1C1 = _
        "=IF(RC4<>""Active"","""", IF(RC5>DATE(YEAR(TODAY()),MONTH(TODAY())+6,DAY(TODAY())), """", ""Yes"" ))"
    End With
'-----------------------------------------------------------------------------------------------------------
    With Range("header6M")
        .EntireColumn.Offset(0, 1).Insert
        .Offset(0, 1).Name = "header12M"
        .Offset(0, 1).Value = "Under 12 Months"
    End With
    Range("header12M").Offset(1, 0).Resize(LastRow).Name = "rng12M"
    With Range("rng12M")
        .FormulaR1C1 = _
        "=IF(R2C4<>""active"", """", IF(RC[-1]=""Yes"","""",IF(RC5>DATE(YEAR(TODAY()),MONTH(TODAY())+12,DAY(TODAY())), """", ""Yes"" )))"
    End With
    '-----------------------------------------------------------------------------------------------------------------------------------
    With Range("header12M")
        .EntireColumn.Offset(0, 1).Insert
        .Offset(0, 1).Name = "header18M"
        .Offset(0, 1).Value = "Under 18 Months"
    End With
    Range("header18M").Offset(1, 0).Resize(LastRow).Name = "rng18M"
    With Range("rng18M")
        .FormulaR1C1 = _
        "=IF(RC4<>""active"", """", IF(RC[-1]=""Yes"", """", IF(RC5>DATE(YEAR(TODAY()),MONTH(TODAY())+18,DAY(TODAY())), """", ""Yes"" )))"
    End With
    '------------------------------------------------------------------------------------------------------------------------------------
    With Range("header18M")
        .EntireColumn.Offset(0, 1).Insert
        .Offset(0, 1).Name = "header4Y"
        .Offset(0, 1).Value = "Under 4 Years"
    End With
    Range("header4Y").Offset(1, 0).Resize(LastRow).Name = "rng4Y"
    With Range("rng4Y")
        .FormulaR1C1 = _
        "=IF(RC4<>""active"", """", IF(RC[-1]=""Yes"", """",IF(DATE(YEAR(RC5),MONTH(RC5),DAY(RC5))<(DATE(YEAR(TODAY())+4,MONTH(TODAY()), DAY(TODAY()))),""Yes"","""")))"
    End With
    '----------------------------------------------------------------------------------------------------------------------------------------------------
    With Range("header4Y")
        .EntireColumn.Offset(0, 1).Insert
        .Offset(0, 1).Name = "headerTR"
        .Offset(0, 1).Value = "Time Remaining to Replace Card"
    End With
    Range("header4Y").Offset(1, 0).Resize(LastRow).Name = "rngTR"
    With Range("rngTR")
        .FormulaR1C1 = "=IF(RC4<>""Active"","""", IF(RC5<TODAY()+365,DATEDIF(TODAY(),RC5,""ym"")&"" months, ""&DATEDIF(TODAY(),RC5,""md"")&"" days"", IF(AND(RC5>TODAY()+365, RC5<TODAY()+730), DATEDIF(TODAY(),RC5,""y"") & "" year, "" & DATEDIF(TODAY(),RC5,""ym"") & "" months, "" & DATEDIF(TODAY(),RC5,""md"") & "" days "", DATEDIF(TODAY(),RC5,""y"")&"" years, ""& DATEDIF(TODAY(),RC5,""ym"")&"" months, ""& DATEDIF(TODAY(),RC5,""md"")&"" days"")))"
    End With
    '--------------------------------------------------------------------------------------------------------------------------------------------
    ThisWs.Calculate


    With Range("tbl_P")
        .WrapText = False
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Columns.AutoFit
    End With
    '==============================================================
    With Range("ws_Dates_SearchRow")
         .Cells.BorderAround ColorIndex:=1, Weight:=xlThick
        '.Cells.Borders Weight = xlThick
'        .Cells.Borders (xlEdgeBottom)
'        .BorderAround (Weight = xlThick)
'        .LineStyle = xlContinuous
'        .Weight = xlThick
        '.Cells.ColorIndex = 1
        '.Interior.PatternColorIndex = xlAutomatic
        .Cells.Interior.Color = RGB(217, 217, 217)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 '-------------------------------------------------------------
    Range("A1").Activate
    ActiveWindow.DisplayGridlines = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = True
    
End With 'ThisWs
End Sub
 
Last edited:

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
i dont think you would do any harm

' range ws_Dates_SearchRow created in m_sort_XDATES
' range "tbl_P" created in m_sort_XDATES
'----------------------------------------------------------------------------------------
With Range("ws_Dates_SearchRow")

creating the search range in the code where you are using it
 
Upvote 0
Thanks, I appreciate you looking at this. I took it out in the process of trying to educate myself on how to clean up code. Sadly, no difference.
Runtime error '91': "Object variable or with block variable not set" on the .Find line.

Code: 
[/FONT][/COLOR] With Range("ws_Dates_SearchRow")
        .Find(What:="Email", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Select
[COLOR=#242729][FONT=Arial]
 
Upvote 0
You will get that error if it cannot find the value you are looking for (then it doesn't know what to select).

You can handle that by instead of selecting the range, store it. Then check it to see if it found it before selecting it, i.e.
Code: 
    Dim fnd As Range
 
    With Range("ws_Dates_SearchRow")
        Set fnd = .Find(What:="Email", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
             MatchCase:=False, SearchFormat:=False)
    End With

'   Select range, if found, otherwise return message box
    If Not fnd Is Nothing Then
        fnd.Select
    Else
        MsgBox "Value not found"
    End If
 
Last edited:
Upvote 0
Whilst this isn't the problem, it looks wrong
Code: 
With Range("ws_Dates_SearchRow")
        .Find(What:="CARD EXPIRY DATE", LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Select
    End With
    Selection.Name = "headerXDATE"
    Range("[COLOR=#ff0000]headerID[/COLOR]").Offset(1, 0).Resize(LastRow).Name = "c_P_XDATE"
    Range("[COLOR=#ff0000]c_P_ID[/COLOR]").NumberFormat = "General"
 
Upvote 0
Solution
Yes, I failed at my QC and keeping good notes as remarks as I bounced between working on the VB and getting the job done for the moment for several weeks now. Again, sadly, the reason I changed the code to "xlpart" is because I have triple checked that the string is there, and tried TRIM and a couple of other things on the string to try and remove any "ghost-trons."
I hate to give up and use RC, but I may be forced to.
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question Question
Error 1004: Copy method of Range class failed
Replies
2
Views
409
Alex Blakenburg
A
J
  • Solved
Unable to find error in code - Runtime 1004 error.
Replies
4
Views
739
Justplainj
J
R
  • Question Question
Method range of object _worksheet failed 1004 vba
Replies
4
Views
847
Rfriend
R
E
  • Solved
Macro stops working before end sub with no prompt
2 3
Replies
21
Views
2K
_eNVy_
E
O
  • Question Question
Find columns dynamically
Replies
0
Views
383
OctavianS
O

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,631
Latest member
a_potato

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