Find function not working after sub

[ddoublev]

Hi,

I have a workbook that when opened executes a sub to search a range for username match and execute certain code dependent on the result. (works as intended)
There are userforms used for data entry throughout the workbook which includes a find function to see if a date record already exists in the table and return values into the form if found. (works as intended)

The problem i am having is that after the workbook is opened and AccessWorkbook() executed the find function of the userforms no longer works. I have isolated the issue to be within the Sub AccessWorkbook. If i disable the sub from being called at the beginning the .Find function works properly.

Is anyone able to identify what may be causing the issue?

VBA - Workbook Access (Executed on workbook_open)

Sub AccessWorkbook()


    
    Dim FindString As String
    Dim Rng As Range
    FindString = Environ("UserName")
    If Trim(FindString) <> "" Then
        With Sheets("Admin").Range("B:B")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Call LoopThroughAdmin 'No issue here
            Else
                Call LoopThroughUser 'No issue here
            End If
        End With
    End If


    
End Sub

VBA - Userform find record

Dim DateFound As Range


Private Sub BoxDate_Change()
    
    Dim dFind As Date
    Dim ctl As MSForms.Control




If IsDate(BoxDate) = False Then Call NotFound
   
        dFind = BoxDate




    With Range("DateSPWTP") 'a named range on sheet listing dates
        Set DateFound = .Find(dFind)
        If DateFound Is Nothing Then
            Call NotFound
        Else
            With DateFound
                On Error Resume Next


    If .Offset(0, 1) <> "" Then
        BoxOperator = .Offset(0, 1)
        Else: BoxOperator = ""
    End If
    If .Offset(0, 2) <> "" Then
        Page1Box1 = .Offset(0, 2)
        Else: Page1Box1 = ""
    End If
    If .Offset(0, 6) <> "" Then
        Page1Box2 = .Offset(0, 6)
        Else: Page1Box2 = ""
    End If

    cmdSubmit.Caption = "Update"


    MsgBox ("Record Found!")


            End With
        End If
    End With


End Sub

Sub NotFound()
    cmdSubmit.Caption = "Submit & Close"
    For Each ctl In SpinifexCampWTPNew.Controls
    If TypeName(ctl) = "TextBox" Then
        ctl.Value = ""
    End If
    Next ctl
End Sub

 

[Warship]

I did not set up a Workbook to troubleshoot but my guess is it is because you are setting all Find parameters in AccessWorkbook but in BoxDate_Change only setting the What parameter. Try setting all parameters in BoxDate_Change to whatever values that particular routine needs. just a quick thought...