Assistance Request in VBA Intersect Function

[DJKennyDubs]

Hello all,

I am attempting to combine two Workbook Subs that were written before into one Master Intersect sub that will .Select the cell upon user input.

First things first...

Now for the code:

First One checks all worksheets within the book for the only cell turned green (=today()) and sets the cursor location to that cell.

Sub FindAndExecute()

Dim Sh As Worksheet
Dim Loc As Range

For Each Sh In ThisWorkbook.Worksheets
    With Sh.UsedRange
        Set Loc = Application.FindFormat.Interior.Color = rgbGreen
        If Not Loc Is Nothing Then
            Do Until Loc Is Nothing
                Set Loc = .FindNext(Loc)
            Loop
        End If
    End With
    Set Loc = Nothing
Next

End Sub

Next one asks the user to input their Last Name immediately upon Worksheet Open, and then the cursor location is set to that cell (Goto).

Private Sub Workbook_Open()
    Dim FindString As String
    Dim Rng As Range
    FindString = InputBox("Enter your Last Name")
    If Trim(FindString) <> "" Then
        With ActiveSheet.Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub

What I'm TRYING to do is combine the two processes with an INTERSECT.select that will take the Column of the cell identified in the FindAndExecute sub and the Row of the cell identified by the Workbook_Open Sub so that
A) The Workbook asks for the Last Name upon Workbook Opening
B) The Cell that intersects with today()+the User's Last Name is focused on/selected and ready for input

I feel like I'm soooo close but the answer is just eluding me. Thanks in advance for the assistance! This community has helped me learn so much!

 

[DJKennyDubs]

I think I figured it out. I put a Wildcard (*) in front and behind the FindName and it's operating like a charm. I'm posting the entire Workbook open code because even though it works, it may be a bit inefficient...AND others may be able to use this too.

Private Sub Workbook_Open()
    Dim Today As Date
    Dim Counter As Integer
    Dim CurrentSheet As Integer

    Search = Today
    
    CurrentSheet = ActiveSheet.Index
    SheetCount = ActiveWorkbook.Sheets.Count
    If IsError(CDbl(Search)) = False Then Search = CDbl(Search)
    For Counter = 1 To SheetCount
        Sheets(Counter).Activate
    
    For Each cell In ActiveSheet.Range("B3:IV3")
    If cell.Value = [Today()] Then
    cell.Select
    End If
Next

Next
FindMyName
End Sub
Private Sub FindMyName()
    Dim FindName    As Variant, c As Variant, r As Variant
   
    On Error GoTo myerror
    c = Application.Match(CLng(Date), Range("C5:AG5"), 0)
    If IsError(c) Then Err.Raise 744
        Do
            FindName = InputBox("Enter your Last Name", "Last Name")
            If StrPtr(FindName) = 0 Then Exit Sub
        Loop Until Len(FindName) > 0
        r = Application.Match("*" & FindName & "*", Range("A:A"), 0)
        If IsError(r) Then Err.Raise 744
        Cells(CLng(r), CLng(c) + 2).Select

myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
   
End Sub

If you can think of any improvements to the code, I would love to learn from you guys! Thanks for all the help, Dave!!

Ken

 

[dmt32]

If you can think of any improvements to the code, I would love to learn from you guys! Thanks for all the help, Dave!!

Ken

Glad you managed to resolve

Dave

 

[DJKennyDubs]

Glad you managed to resolve

Dave

I want to re-open this thread because I would like to figure out how I would apply the code to the entire workbook (searching for the correct date/name combination no matter which sheet is the active sheet. The problem I'm coming up with is that I get a "Search String Not Found" error now that I've had to create a new sheet for December. The search won't look through previous sheets anymore. I appreciate any input you can provide!

~Ken

 

[DJKennyDubs]

I want to re-open this thread because I would like to figure out how I would apply the code to the entire workbook (searching for the correct date/name combination no matter which sheet is the active sheet. The problem I'm coming up with is that I get a "Search String Not Found" error now that I've had to create a new sheet for December. The search won't look through previous sheets anymore. I appreciate any input you can provide!

~Ken

Okay, so I tinkered with it for a little bit longer and if I set the ActiveSheet as the 1st Sheet in the index first (Worksheets (1).Select), then I don't get the error anymore. I'm posting the code as it stands so far but if anyone can make improvements, I'd appreciate it!

Private Sub Workbook_Open()

Dim Sh As Worksheet
Dim Loc As Range

Worksheets(1).Select

For Each Sh In ThisWorkbook.Worksheets
    With Sh.UsedRange
        Set Loc = .Cells.Find(What:=[today()], LookIn:=xlFormulas)
        If Not Loc Is Nothing Then
            Exit For
        End If
    End With
Next
If Not Loc Is Nothing Then
    Loc.Parent.Activate
    Loc.Select
End If

FindMyName

End Sub
Private Sub FindMyName()
    Dim FindName    As Variant, c As Variant, r As Variant
   
    On Error GoTo myerror
    c = Application.Match(CLng(Date), Range("C5:AG5"), 0)
    If IsError(c) Then Err.Raise 744
        Do
            FindName = InputBox("Enter your Last Name", "Last Name")
            If StrPtr(FindName) = 0 Then Exit Sub
        Loop Until Len(FindName) > 0
        r = Application.Match("*" & FindName & "*", Range("A:A"), 0)
        If IsError(r) Then Err.Raise 744
        Cells(CLng(r), CLng(c) + 2).Select

myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
   
End Sub

 

[DJKennyDubs]

Okay, so I tinkered with it for a little bit longer and if I set the ActiveSheet as the 1st Sheet in the index first (Worksheets (1).Select), then I don't get the error anymore. I'm posting the code as it stands so far but if anyone can make improvements, I'd appreciate it!

Private Sub Workbook_Open()

Dim Sh As Worksheet
Dim Loc As Range

Worksheets(1).Select

For Each Sh In ThisWorkbook.Worksheets
    With Sh.UsedRange
        Set Loc = .Cells.Find(What:=[today()], LookIn:=xlFormulas)
        If Not Loc Is Nothing Then
            Exit For
        End If
    End With
Next
If Not Loc Is Nothing Then
    Loc.Parent.Activate
    Loc.Select
End If

FindMyName

End Sub
Private Sub FindMyName()
    Dim FindName    As Variant, c As Variant, r As Variant
  
    On Error GoTo myerror
    c = Application.Match(CLng(Date), Range("C5:AG5"), 0)
    If IsError(c) Then Err.Raise 744
        Do
            FindName = InputBox("Enter your Last Name", "Last Name")
            If StrPtr(FindName) = 0 Then Exit Sub
        Loop Until Len(FindName) > 0
        r = Application.Match("*" & FindName & "*", Range("A:A"), 0)
        If IsError(r) Then Err.Raise 744
        Cells(CLng(r), CLng(c) + 2).Select

myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
  
End Sub

Never mind...this code does NOT work but the formula previously posted does...not sure why but I'm ready to put this issue to rest.