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

Shiseiji

Board Regular
Joined
Oct 23, 2009
Messages
153
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.

mole999

Moderator
Joined
Oct 23, 2004
Messages
10,524
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
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
 

Shiseiji

Board Regular
Joined
Oct 23, 2009
Messages
153
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]
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
57,023
Office Version
  1. 365
Platform
  1. Windows
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:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,901
Office Version
  1. 365
Platform
  1. Windows
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"
 
Solution

Shiseiji

Board Regular
Joined
Oct 23, 2009
Messages
153
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,192
Messages
5,640,764
Members
417,165
Latest member
Hilders1

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
Top