Dumbfounded

[Countryboy69]

Ok I'm wondering if there is a formula, macro, program, or some thing I've never heard of that will have a cell if filled out with certain information search through files and open certain files?

 

[Yongle]

Not sure if they have the same extensions

VBA coded to find CellValue.xls(Excel 2003 files) , CellValue.xlsx (2007+) , CellValue.xlsm (macro-enabled 2007+) ....etc
Lokking for a string containing rather than exactly = CellValue.xls in this line

If InStr(1, aFile.Name, sTxt & Ext, vbTextCompare) > 0 Then

For now just open the work book - in the future I want it to start another macro to pull specific data from opened worksheet

- OpenWorkbook is returned as a workook-type variable as illustrated in the code..

MsgBox "Workbook found" & vbCr & vbCr & [COLOR=#ff0000]OpenWorkbook.FullName[/COLOR]

Q Do you want this macro to run automatically after cell in B3:B74 changes?
A Yes would make it better

Code is triggered when values in any cell in range B3:B74 is edited

Test in a COPY of your workbook

Adding code to your workbook
Paste code into SHEET module
right-click sheet tab \ View Code \ Paste code into the window that opens \ amend ParentPath \ return to Excel with {ALT} {F11}

Testing
Amend the value in any cell in range B3:B74
(using {F2} to edit cell followed by {ENTER} may also trigger code to run)

Option Explicit
Private Const TargetRng = "B3:B74"
Private Const ParentPath = "[COLOR=#ff0000]C:\folder\subfolder[/COLOR]"
[I]
[COLOR=#006400]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/I]
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Range(TargetRng), Target) Is Nothing Then
        Call OpenWorkbook(Target.Value)
    End If
[I][COLOR=#006400]End Sub[/COLOR][/I]
[I][COLOR=#006400]
Private Function OpenWorkbook(SearchFor As String) As Workbook[/COLOR][/I]
    Dim fPath As String: fPath = GetFilePath(ParentPath & Chr(92), SearchFor, ".xls", True)
    If Len(fPath) > 0 Then
        Set OpenWorkbook = Workbooks.Open(fPath)
        MsgBox "Workbook found" & vbCr & vbCr & OpenWorkbook.FullName
    Else
        MsgBox SearchFor & " not found"
    End If
    
[COLOR=#006400][I]End Function[/I][/COLOR]
[I][COLOR=#006400]
Private Function GetFilePath(ParentFolder As String, sTxt As String, Ext As String, SearchParent As Boolean) As String[/COLOR][/I]
    Dim FSO As Object, Fldr, SubFldr, aFile
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Fldr = FSO.GetFolder(ParentFolder)
[COLOR=#a52a2a]'SearchParentFolder[/COLOR]
    If SearchParent Then
        For Each aFile In Fldr.Files
            If InStr(1, aFile.Name, sTxt & Ext, vbTextCompare) > 0 Then
                GetFilePath = aFile.Path
                Exit Function
            End If
        Next aFile
    End If
[COLOR=#a52a2a]'SearchSubFolders[/COLOR]
    For Each SubFldr In Fldr.SubFolders
        For Each aFile In SubFldr.Files
            If InStr(1, aFile.Name, sTxt, vbTextCompare) > 0 Then
                GetFilePath = aFile.Path
                Exit Function
            End If
        Next aFile
        GetFilePath = GetFilePath(SubFldr.Path, sTxt, Ext, False)
    Next SubFldr
    GetFilePath = ""
[I][COLOR=#006400]End Function[/COLOR][/I]

 

[Countryboy69]

Thanks man this worked perfectly thank you so much

 

[Countryboy69]

So was just wondering if I wanted it to activate only when enter is pressed how would you do that

 

[Yongle]

If you want to activate the code when simply selecting a cell, add another procedure in the same module below other code

[FONT=Consolas]Private Sub [/FONT][FONT=Consolas]Worksheet_SelectionChange([/FONT][FONT=Consolas]ByVal[/FONT][FONT=Consolas] Target [/FONT][FONT=Consolas]As[/FONT][FONT=Consolas] Range)
  - use exactly same code as [I]Worksheet_Change
[/I][/FONT][FONT=Consolas]End Sub[/FONT]

 

[Yongle]

Perhaps adding a message box asking user to confirm

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Range(TargetRng), Target) Is Nothing Then
        If MsgBox("Open " & Target) = vbOK Then Call OpenWorkbook(Target.Value)
    End If
End Sub

 

[Countryboy69]

im taking it doesnt matter where i place this in the macro it will still work?

 

[Yongle]

Instead of using SelectionChange ...
- open a workbook by double-clicking on any cell in the range with this

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Range(TargetRng), Target) Is Nothing Then
        Cancel = True
        Call OpenWorkbook(Target.Value)
    End If
End Sub

 

[Countryboy69]

sweet thanks again man this macro ran great today. just have one more thing i gotta figure out then it will be an awesome workbook!!!

 

[Yongle]

Another alternative for you

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Range(TargetRng), Target) Is Nothing Then
        Cancel = True
        Call OpenWorkbook(Target.Value)
    End If
End Sub

 

[Countryboy69]

i dunno how you come up with this stuff bro but your freaking awesome