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]

Simplified the date find from the first Code to the following:

Private Sub Workbook_Open()

For Each cell In ActiveSheet.Range("C5:AG5")
    If cell.Value = [Today()] Then
    cell.Select
    End If
Next

Call FindName

End Sub

 

[DJKennyDubs]

Simplified the date find from the first Code to the following:

Private Sub Workbook_Open()

For Each cell In ActiveSheet.Range("C5:AG5")
    If cell.Value = [Today()] Then
    cell.Select
    End If
Next

Call FindName

End Sub

So now, it Automatically finds today's date upon opening, moves the cursor there. Then it runs the second code (renamed to FindName) so it finds the name. Only problem is that the cursor doesn't remain in the correct column as it moves to the cell with the Name

 

[dmt32]

Hi,
untested but see if this update to your code does what you want

Private Sub Workbook_Open()
    Dim FindName    As Variant, c As Variant, r As Variant
   
    'find todays date in range
    c = Application.Match(CLng(Date), Range("C5:AG5"), 0)
    If Not IsError(c) Then
        'get last name
        Do
            FindName = InputBox("Enter your Last Name", "Last Name")
            'cancel pressed
            If StrPtr(FindName) = 0 Then Exit Sub
        Loop Until Len(FindName) > 0
        'find name in range
        r = Application.Match(FindName, Range("A:A"), 0)
        'select column
        If Not IsError(r) Then Cells(CLng(r), CLng(c)).Select
    End If
   
End Sub

Dave

 

[DJKennyDubs]

Hi,
untested but see if this update to your code does what you want

Private Sub Workbook_Open()
    Dim FindName    As Variant, c As Variant, r As Variant
  
    'find todays date in range
    c = Application.Match(CLng(Date), Range("C5:AG5"), 0)
    If Not IsError(c) Then
        'get last name
        Do
            FindName = InputBox("Enter your Last Name", "Last Name")
            'cancel pressed
            If StrPtr(FindName) = 0 Then Exit Sub
        Loop Until Len(FindName) > 0
        'find name in range
        r = Application.Match(FindName, Range("A:A"), 0)
        'select column
        If Not IsError(r) Then Cells(CLng(r), CLng(c)).Select
    End If
  
End Sub

Dave

If it's finding any data, it's not moving the cursor to that cell...is this something that needs a .goto or .select somewhere to tell the activecell to move? Thanks for the help!

 

[DJKennyDubs]

If it's finding any data, it's not moving the cursor to that cell...is this something that needs a .goto or .select somewhere to tell the activecell to move? Thanks for the help!

I see the .Select in the last full line of code but I'll try to troubleshoot it. ~Ken

 

[dmt32]

I see the .Select in the last full line of code but I'll try to troubleshoot it. ~Ken

solution assumes that the required sheet is the activesheet & that the dates in range C5:AG5 are real dates

If solution does not resolve then to assist forum I suggest that you post copy of your worksheet using MrExcel Addin: XL2BB - Excel Range to BBCode

Dave

 

[DJKennyDubs]

Unfortunately, I cannot download the add-in since I'm not the administrator for my network...To answer your other question, I have a formula that puts in the date in each of the date cells so it's not technically a "real date." I was thinking about it and am wondering if there is a way to call the row number from one sub (call it rN), call the column number from the other sub (cN), and mash them together into an

Application.goto Reference:=Activesheet.Range("cNrN"), _
Scroll:= True

Let me know what you all think!

Ken

 

[dmt32]

Let me know what you all think!

Ken

sounds like your dates are likely to be strings

based on the image you posted see if this update resolves the issue

Private Sub Workbook_Open()
    Dim FindName    As Variant, c As Variant, r As Variant
   
    On Error GoTo myerror
    'find todays date in range
    c = Application.Match(Format(Date, "dddd mm/dd"), Range("C5:AG5"), 0)
    If IsError(c) Then Err.Raise 744
        'get last name
        Do
            FindName = InputBox("Enter your Last Name", "Last Name")
            'cancel pressed
            If StrPtr(FindName) = 0 Then Exit Sub
        Loop Until Len(FindName) > 0
        'find name in range
        r = Application.Match(FindName, Range("A:A"), 0)
        If IsError(r) Then Err.Raise 744
        'select column
        Cells(CLng(r), CLng(c) + 2).Select

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

Code assumes required sheet is the activesheet
I have also included error reporting if values not found.

Dave

 

[DJKennyDubs]

sounds like your dates are likely to be strings

based on the image you posted see if this update resolves the issue

Private Sub Workbook_Open()
    Dim FindName    As Variant, c As Variant, r As Variant
  
    On Error GoTo myerror
    'find todays date in range
    c = Application.Match(Format(Date, "dddd mm/dd"), Range("C5:AG5"), 0)
    If IsError(c) Then Err.Raise 744
        'get last name
        Do
            FindName = InputBox("Enter your Last Name", "Last Name")
            'cancel pressed
            If StrPtr(FindName) = 0 Then Exit Sub
        Loop Until Len(FindName) > 0
        'find name in range
        r = Application.Match(FindName, Range("A:A"), 0)
        If IsError(r) Then Err.Raise 744
        'select column
        Cells(CLng(r), CLng(c) + 2).Select

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

Code assumes required sheet is the activesheet
I have also included error reporting if values not found.

Dave

Dave,

We're really close...I altered your code to find today's date within the active sheet as such:

Private Sub FindMyName()
    Dim FindName    As Variant, c As Variant, r As Variant
   
    On Error GoTo myerror
    'find todays date in range
    c = Application.Match(CLng(Date), Range("C5:AG5"), 0)
    If IsError(c) Then Err.Raise 744
        'get last name
        Do
            FindName = InputBox("Enter your Last Name", "Last Name")
            'cancel pressed
            If StrPtr(FindName) = 0 Then Exit Sub
        Loop Until Len(FindName) > 0
        'find name in range
        r = Application.Match(FindName, Range("A:A"), 0)
        If IsError(r) Then Err.Raise 744
        'select column
        Cells(CLng(r), CLng(c) + 2).Select

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

The only thing left to do is to change the name search function to look for a string (since the Name in Column A is not just the Last Name but in the format Last Name, First Name). I think we just need to switch FindName to a String and change the r= to something that will look for that string. Also, I took out the _Open() Function since I'm going to run a different sub first to change the active page to the one with today's date before this sub is run. I appreciate your input!

Ken