creating new folder by Copying folder template and naming it with cell value

[DrMaghrabi]

Hello!

can someone help me in creating a code to perform the following: (NB. I don't Know coding)

I have an excel file contain a column with series no. (1,2,3,etc..) and a folder [named: Customers] contain folders named correspondingly but with leading zeros for the purpose of sorting thing as ( 0001, 0002, 0003, etc...)
I want when I add new number in the list [for ex: 52], it creates a new folder by copying the template Folder [new](in the folder: Customers) and its files content and name it [0052] and make the cell hyperlinked to this folder, so it opens the folder when I click on the number.

Thank you

 

[Logit]

Ok ... I got all of that. However the code is not doing anything.

This is what I have for your code :

Option Explicit

Public fPat As String
Public tPat As String

Public Sub MySub()
   fPat = "C:\Users\gagli\OneDrive\Desktop\Customers" '<--- CHANGE PATH TO MATCH YOUR DESTINATION
   tPat = "C:\Users\gagli\OneDrive\Desktop\template" '<--- CHANGE PATH TO MATCH YOUR DESTINATION
   Call demo
End Sub

Private Sub demo()
   Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
   Dim ws As Worksheet
   Set ws = ThisWorkbook.Sheets("Sheet1")
   Dim rng As Range
   Set rng = ws.Range("A2:A1048576")
   Dim cel As Range
   Dim fol As String
 
   For Each cel In rng.Cells
      If cel.Value2 = "" Then Exit For
      If IsNumeric(cel.Value2) = False Then GoTo skip
      fol = x(cel.Value2)
      Select Case fol
         Case "Err"
            Debug.Print "An Error occured. Please review data."
            GoTo skip
         Case Else
            If (Dir(fPat & "\" & fol, vbDirectory) = "") Then
               fso.CopyFolder tPat, fPat & "\" & fol
               ws.Hyperlinks.Add cel, FolderPath & "\" & fol '<--- NEW CODE
            End If
         End Select
skip:
   Next cel
End Sub

Private Function x(val As Variant) As String
   Select Case Len(val)
      Case 1
         x = "000" & val
      Case 2
         x = "00" & val
      Case 3
         x = "0" & val
      Case 4
         x = val
      Case Else
         x = "Err"
   End Select
End Function

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   Call MySub
End Sub

 

[Logit]

You can download my workbook here :

Download : Internxt Drive – Private & Secure Cloud Storage

 

[PeteWright]

I have downloaded your Workbook.
Do you have some sample data in your Template folder?

 

[Logit]

See the images below ...

 

[PeteWright]

Got it.

You need to place the whole code in your Workbook instead of Sheet1 for two reasons:

1. Workbook_SheetChange is a Workbook function and therefore must be placed within the Workbook
2. The rest of the code is declared Private so if placed somewhere else it won't be available

Your Workbook code is empty by now:

Try it again with the code inside Workbook

 

[Logit]

Ok ... thank you. It is working now.

 

[DrMaghrabi]

It gave me this error

Sorry for the many errors I got.

 

[PeteWright]

View attachment 101047
It gave me this error

Sorry for the many errors I got.

Oops, I have changed the variable name.

Please change the selected code from "FolderPath" to "fpat" and it should work.

 

[DrMaghrabi]

Oops, I have changed the variable name.

Please change the selected code from "FolderPath" to "fpat" and it should work.

Ok It created a hyperlinks for the newly created files but for the already existing files, it didn't.

 

[PeteWright]

Ok It created a hyperlinks for the newly created files but for the already existing files, it didn't.

nope, it doesn't. Should the Macro check for existing hyperlinks and create if not present?