Search Directory for Create Hyperlink of folder based on cell String

Quote from mamun.ges

Hi,

I searched on many websites but did not get similar things. I am sharing my thoughts. Hope someone helps me with the suggestion, sample file, or link.

In my worksheet Cell, E9 to E100 has Some names. I want to make those names as hyperlinks.

There are few folders in "E:\Names\ " having exact same name of E9 to E100 column ( E9:E100 is the column range).

Now the facts:

Now If the folder name matches the cell String then the hyperlink creating on that cell.

If there is a folder which name is not matched with any cell string then nothing happens.

If there is a cell string but no folder is matched exact same name in that directory then a folder will be created based on the name of the cell string along with the hyperlink.

If any new name is add in cell E9 to E100 then automatically a folder will be created along with the hyperlink.

Can it be done with VBA? If so, please.

Thank you in advance.

Display More

Hi there, I hope this is what you mean?

Sub CreationHyperlink()

Dim Path As String
Dim Folder As String

For CheckingCells = 9 To 100
CheckingValue = Cells(CheckingCells, 5).Value
CheckingValueAdress = Cells(CheckingCells, 5).Address

    Path = "E:\Names\" & CheckingValue

    Folder = Dir(Path, vbDirectory)
 
    If Folder = vbNullString Then
    VBA.FileSystem.MkDir (Path)
    ActiveSheet.Hyperlinks.Add Anchor:=Range(CheckingValueAdress), Address:="E:\Names\" & CheckingValue, _
    TextToDisplay:=CheckingValue
        
    Else
    ActiveSheet.Hyperlinks.Add Anchor:=Range(CheckingValueAdress), Address:="E:\Names\" & CheckingValue, _
        TextToDisplay:=CheckingValue



    End If
Next CheckingCells




End Sub

Let me know if it worked

Quote from mamun.ges

Thanks, VincentNL

Excellent Work except for the following problem.

First, the code creates the hyperlink.

Second, After Hyperlink the front E9:E100 changes Times New Roman to Calibri. (No Change in front)

Third, Whenever the mouse courser comes to E9:E100 it changes to Hand selection and opens a popup massage. (No Hand tool, Press CTRL+Selection to open the hyperlink.

Fourth, Gives an error (Here is the attachment)

Hope you can solve it.

Display More

Hi there,

Hope you can clarify

1. Only no hyperlink should be created when no folder name matches any string right?

2. That's fixable

3. You don't want the popup message and change of tool icon?

4. Can you attach a worksheet in what the code gives an error?

Quote from mamun.ges

Hi. VincentNL

Clarify

1: Yes

2. Front should be as it.

3. Pop-up Message is not a problem. The problem is it stay always active. I want that Only when pressing down the CTRL of Keyboard the hyperlink active. If then select the cell it will give me a popup message whether I want to open the link. (Or any better suggestion: Appreciate)

4 . Here is an attached file Hyper.xlsm as a sample.

Best regards.

Display More

Hey Mamun,

Thanks for adding the workbook, I hope my following changing are helpfull:

1. Now if the value of the cell is empty nothing will happen, this will stop the error from accuring

2. I added the style of the range to change to your description

3. Added the code for automatically running the macro when values change in the range

As for your next comment "I want that Only when pressing down the CTRL of Keyboard the hyperlink active", I got that working but it kept crashing the excel workbook every 10 seconds, so not sure about it yet

Put this code in a module:

Sub hyper()


Dim Path As String
Dim Folder As String

For CheckingCells = 9 To 100
CheckingValue = Cells(CheckingCells, 5).Value
CheckingValueAdress = Cells(CheckingCells, 5).Address

 Path = "E:\Names\" & CheckingValue

 Folder = Dir(Path, vbDirectory)
 
 If CheckingValue = vbNullString Then
 ElseIf Folder = vbNullString Then
 VBA.FileSystem.MkDir (Path)
    Range(CheckingValueAdress).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="E:\names\" & CheckingValue, _
        TextToDisplay:=CheckingValue
 
 Else
    Range(CheckingValueAdress).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="E:\names\" & CheckingValue, _
        TextToDisplay:=CheckingValue



 End If
Next CheckingCells

With Range("e9:e100").Font
                    .ColorIndex = x1Automatic
                    .Underline = xlUnderlineStyleNone
                    .Name = "Times New Roman"
                    .Size = 18
End With
End Sub

Put this code in the sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E9:E100")) Is Nothing Then
Call hyper
End If
End Sub