Creating Folders based on cell values

[vbwanab]

Hi All,

Wondered if some bright spark can assist with an issue im having?

I have a spreadsheet which has product column on the left and to the right are various document names as column headers.

I have colour codes: Green = Received, Orange = Requested, Red = attention. Users enter short text in the cells to describe the present position of the document, and colour code accordingly.

Scenario
(assume directory is already created as : "Product Name/Document header/<date & cell value here>) - bolded is already created in the directory.

User clicks on a cell, and clicks on "create folder" button. The button should pull the Product Name from the spreadsheet, pull the relevant document column header from where the user has selected the cell and create a new folder as above based on the date and active cell text: "<date & cell value/text here>". The date should be in this format yyyy/mm/dd so that the folders flow down the directory in date order, so that the folders are not in random order.

I want the "create folder" button to also check if the folder already exists as to not overwrite any previously created folder with the same date and cell value/text.


The aim is that the spreadsheet will be used as the hub.

Look forward to any replies and suggestions,

Best wishes.

[p24leclerc]

is it possible to attach a sample file so we have something to work on? It is always easier with examples.

[vbwanab]

Hi there, thank you for the quick response.

Please see attached. I have added some requirements if that is ok, most of which seem straight forward (to a pro). Thought id add them to save asking again.

If you look at the black bordered items and probably will make more sense to start with "create folders" example.

Again, thank you and i appreciate your help.

Example created in Excel 07

Best wishes!

[p24leclerc]

you're asking to create folders but what documents are going to be in those folders. I have but no clue.

[vbwanab]

I didnt think it mattered what docs are going to be in the folders as the users will just be dragging and dropping the docs into the folders that are created by the Spreadsheet.. The main issue is what is outlined in the spreadsheet, would appreciate your help if you have an idea as to how to go about it.

The spreadsheet outlined a couple of the docs but there are many more, i just need an example (hence the spreadsheet) and i can do the rest..THe docs will be pdf's word docs etc, but i didnt think this mattered as mentioned. Thanks for your help,

THanks for your help,

[p24leclerc]

here is a start for you to work on.
I created the "Create folder", "Open activecell folder" and "Open top folder" macros and they are assigned to your buttons.
I had to replace the "/" in the folder name with "-" because it was giving an error.
Hope this help
Pierre

[p24leclerc]

in the attached file, you'll be able to open PDF and DOC file. In the previous reply, the file was just showing you the folder but there was no program to open the file. You'll need some more programming if you want to open other file type.

[JBeaucaire]

'MAKE FOLDERS AND SUBFOLDERS
Here's a macro for creating all the folders and subfolders in path. There's a macro and a UDF version that other macros can use.

Make Folders and Subfolders

Based on that, I edited it down to your scenario. This will create the folders desired based on the ACTIVECELL, so after someone enters text anywhere in your key section, the cell highlighted is the one used when the macro is activated. Here is the result:

Option Explicit

Sub CreateFolder()
Dim MyPath  As String
Dim MyArr   As Variant
Dim pNum    As Long
Dim pBuf    As String

    On Error Resume Next

    With ActiveCell
        MyPath = "C:\" & Cells(.Row, 1) & "\" & Cells(3, .Column) _
                 & "\" & Format(Date, "YYYYMMDD") & " - " & .Value
    End With

    MyArr = Split(MyPath, "\")
    pBuf = MyArr(LBound(MyArr)) & "\"
    For pNum = LBound(MyArr) + 1 To UBound(MyArr)
        pBuf = pBuf & MyArr(pNum) & "\"
        MkDir pBuf
    Next pNum
End Sub

This code actually does a little more than you asked. It creates all the folders and subfolders from the top level down to the bottom. Of course, if your upper folders already exist it just moves on. This macro assumes C:\ drive is root.

[vbwanab]

bleeding heck, thanks a lot guys you are a helpful bunch!

I will try some out on the weekend and provide an update of course!

With regards to the file types, excuse my ignorance but i still dont get why this matters? The users create and open the folders from the spreadsheet and they drop relevant files in the folders. Maybe i left out that the users will have adobe/word etc but i thought that was presumed since they are the ones that are dropping the files in the created folders. Does this make sense or am i missing something? A side note is that the folders are created and opened within windows explorer, but again i presume that was realised from the example?

Hope this doesnt come across ungrateful, because i am very grateful for the help, thank you all for your help, i will come back shortly on this,,in the meantime, a pointer regarding my above ignorance would be welcome.

[JBeaucaire]

I don't understand the question posed earlier about what files you're going to put into these created folders, either. But the macro I provided will create folders based on the selected cell when you run it.

[vbwanab]

Hi Jerry, Thank you very much for the example, i have adapted it for my spreadhsheet as i realised i may need more dir levels and it works perfectly. Thanks very much for your kind help. Thank you also pierre for your help.

Was curious though, you know the code

: MyPath = "C:\" & Cells(.Row, 1) & "\" & Cells(3, .Column) _

Why does it say "row, 1" when in actual fact it is column 1 it pulls the product name from? It works fine was just curious? Similarly, column 3 when it is row 3 it pulls the sub dir from? Maybe i am reading it in the wrong context?

Do you think you could help with the remainder on my spreadsheet example? I will figure out the "open folder" bit, that cant be hard. It was the "Add note example" i was looking for next.

I would like it to basically pop up entry boxes for the user to input the data as shown on the spreadsheet (pop up entry boxes will be good to restrict their input in the comment), then to insert as comment on the active cell. If there is already a comment in a cell and the user hits add note button, it should start the process again but simply append to the existing one.



BW

[snb]

Wouldn't this suffice ?

Sub snb()
  MkDir "E:\" & Cells(ActiveCell.Row, 1) & "\" & Cells(1, ActiveCell.Column) & "\" & Format(Date, "yyyy_mm_dd ") & ActiveCell
End Sub

[JBeaucaire]

Was curious though, you know the code

: MyPath = "C:\" & Cells(.Row, 1) & "\" & Cells(3, .Column) _

Why does it say "row, 1" when in actual fact it is column 1 it pulls the product name from? It works fine was just curious? Similarly, column 3 when it is row 3 it pulls the sub dir from? Maybe i am reading it in the wrong context?

The Cells() syntax is as follows:

Cell(RowReference, ColumnReference)

So there are two parameters being given values each time it is used. In the first example, Cells(.Row, 1)
...you see the ROW is taken from the row of the Activecell (notice the "with" reference above it?) and we've hardcoded the column to column 1.

The second Cells() formula for the end next part of the path is coming from row 3, the code is Cells(3, .Column)(
...so the row is hardcoded as 3, but the column is taken from the Activecell.

Is that clear how the CELLS() function works? Each parameter is a numeric value.

[vbwanab]

The code jerry posted was fine, it works fine as mentioned.

The second part of my query is as outlined in bold on my previous post.

Thanks for your help,

[JBeaucaire]

You don't need two separate buttons for the notes, you could build the capability in like so:

Sub AddNote()
Dim CmntText As String
Dim CmntNum  As Long

CmntText = "Entry Date:" & vbLf & _
           "Date received:" & vbLf & _
           "Received From:" & vbLf & _
           "Batch Number:" & vbLf & _
           "Exp Date:" & vbLf & _
           "Manufacturer Date:" & vbLf & _
           "Purpose:" & vbLf & _
           "Further Comment:" & vbLf & _
           "Passed to:" & vbLf & _
           "Comments:" & vbLf

On Error GoTo NoComment
    If ActiveCell.Comment.Text <> "" Then
        CmntNum = Int(Len(ActiveCell.Comment.Text) - Len(Replace(ActiveCell.Comment.Text, Chr(10), ""))) / 12
        ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbLf & "Receipt #" & CmntNum + 1 & vbLf & CmntText
        ActiveCell.Select
    End If
    Exit Sub
NoComment:
With ActiveCell
    .AddComment
    .Comment.Visible = True
    .Comment.Text Text:="Receipt #1" & vbLf & CmntText
    .Select
End With

This will add the boilerplate text into a new comment box if none exists, or it will add a new "instance" of the boilerplate into an existing comment, incrementing the receipt #.

Of course, the answers still need to be added by the user, EDIT > COMMENT.

[JBeaucaire]

I just reread it and noticed the "popup and ask questions" idea. This will do that...much longer code, of course...

Sub AddNote()
Dim CmntText As String
Dim Ans      As String
Dim CmntNum  As Long

Do
    Ans = Application.InputBox("Entry Date:", "Entry Date:", Date, Type:=2)
    If Ans = "" Or Ans = "False" Then
        If MsgBox("Entry Date not entered.  Skip it?", vbYesNo, "Skip") _
                                                = vbYes Then Exit Do
    Else
        CmntText = "Entry Date: " & Ans & vbLf
        Ans = ""
        Exit Do
    End If
Loop
Do
    Ans = Application.InputBox("Date received:", "Date received:", Date, Type:=2)
    If Ans = "" Or Ans = "False" Then
        If MsgBox("Date received not entered.  Skip it?", vbYesNo, "Skip") _
                                                = vbYes Then Exit Do
    Else
        CmntText = CmntText & "Date received: " & Ans & vbLf
        Ans = ""
        Exit Do
    End If
Loop
Do
    Ans = Application.InputBox("Received From:", "Received From:", "John Doe", Type:=2)
    If Ans = "" Or Ans = "False" Then
        If MsgBox("Received From not entered.  Skip it?", vbYesNo, "Skip") _
                                                = vbYes Then Exit Do
    Else
        CmntText = CmntText & "Received From: " & Ans & vbLf
        Ans = ""
        Exit Do
    End If
Loop
Do
    Ans = Application.InputBox("Batch Number:", "Batch Number:", 999999, Type:=1)
    If Ans = 999999 Or Ans = 0 Then
        If MsgBox("Batch number not entered.  Skip it?", vbYesNo, "Skip") _
                                                = vbYes Then Exit Do
    Else
        CmntText = CmntText & "Received From: " & Ans & vbLf
        Ans = ""
        Exit Do
    End If
Loop
Do
    Ans = Application.InputBox("Exp Date:", "Exp Date:", Date, Type:=2)
    If Ans = "" Or Ans = "false" Then
        If MsgBox("Exp Date not entered.  Skip it?", vbYesNo, "skip") _
                                                = vbYes Then Exit Do
    Else
        CmntText = CmntText & "Exp Date: " & Ans & vbLf
        Ans = ""
        Exit Do
    End If
Loop
Do
    Ans = Application.InputBox("Manufacturer Date:", "Manufacturer Date:", Date, Type:=2)
    If Ans = "" Or Ans = "False" Then
        If MsgBox("Manufacturer Date not entered.  Skip it?", vbYesNo, "Skip") _
                                                = vbYes Then Exit Do
    Else
        CmntText = CmntText & "Manufacturer Date: " & Ans & vbLf
        Ans = ""
        Exit Do
    End If
Loop
Do
    Ans = Application.InputBox("Purpose:", "Purpose:", Date, Type:=2)
    If Ans = "" Or Ans = "False" Then
        If MsgBox("Purpose not entered.  Skip it?", vbYesNo, "Skip") _
                                                = vbYes Then Exit Do
    Else
        CmntText = CmntText & "Purpose: " & Ans & vbLf
        Ans = ""
        Exit Do
    End If
Loop
Do
    Ans = Application.InputBox("Further Comment:", "Further Comment:", "...", Type:=2)
    If Ans = "..." Or Ans = "False" Then
        If MsgBox("Further Comment not entered.  Skip it?", vbYesNo, "Skip") _
                                                = vbYes Then Exit Do
    Else
        CmntText = CmntText & "Further Comment: " & Ans & vbLf
        Ans = ""
        Exit Do
    End If
Loop

On Error GoTo NoComment
    If ActiveCell.Comment.Text <> "" Then
        CmntNum = Int(Len(ActiveCell.Comment.Text) - Len(Replace(ActiveCell.Comment.Text, Chr(10), ""))) / 12
        ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbLf & "Receipt #" & CmntNum + 1 & vbLf & CmntText
        ActiveCell.Select
    End If
    Exit Sub
NoComment:
With ActiveCell
    .AddComment
    .Comment.Visible = True
    .Comment.Text Text:="Receipt #1" & vbLf & CmntText
    .Select
End With

End Sub

To edit an existing comment, just right-click the target cell end choose Edit Comment.

[JBeaucaire]

The two buttons for opening the activecell folder/top folder:

Sub OpenTopFolder()
Dim fPath As String
Dim MyFolder

With ActiveCell
    fPath = "C:\" & Cells(.Row, 1)
End With



MyFolder = Shell("explorer.exe " & fPath, vbNormalFocus)
End Sub

Sub OpenFolder()
Dim fPath As String
Dim MyFolder

With ActiveCell
    fPath = "C:\" & Cells(.Row, 1) & "\" & Cells(3, .Column)
End With

MyFolder = Shell("explorer.exe " & fPath, vbNormalFocus)
End Sub

[vbwanab]

Hi Jerry,

Thanks very much for the response. I understand with your very well explained post re the row/column syntax now.I ignorantly presumed if row and 1 were in the same bracket, this equaled row 1, which it doesn't.


Thanks for the code re the notes button, i will give this a go and post feedback.

[vbwanab]

Wow, i just noticed you posted again after the iniital "notes code" you mentioned.

Thanks for the code for practically all of my requirements Amazing how much this forum gives. I'm a bit gutted all i can "give" at this present time is a click on your scales ...

Will post back with comments shortly.

[vbwanab]

Hi Jerry, Any ideas on how to capture the batch number as alpha numeric type? I looked it up but there doesnt seem to be a type to cover this?


EDIT
Never mind i just copied the Further comment code

[JBeaucaire]

My apologies, you just needed to edit the Type:=1 to Type:=2. 1 is numeric, 2 is text.

If that takes care of your need, please click EDIT in your original post, click GO ADVANCED and set the PREFIX box to SOLVED.

[vbwanab]

Thank you for the assistance. Thread marked as solved.